Rasch analysis of outcomes

LSAS-SR

Authors
Affiliations
Nils Hentati Isacsson

Centre for Psychiatry Research, Department of Clinical Neuroscience, Karolinska Institutet, & Stockholm Health Care Services, Region Stockholm, Sweden

Magnus Johansson

RISE Research Institutes of Sweden

Published

2024-12-20

1 Setup

Code
library(easyRasch) # devtools::install_github("pgmj/easyRasch")
#library(RISEkbmRasch)
library(grateful)
library(ggrepel)
library(car)
library(kableExtra)
library(tidyverse)
library(eRm)
library(iarm)
library(mirt)
library(psych)
library(psychotree)
library(matrixStats)
library(reshape)
library(knitr)
library(patchwork)
library(formattable) 
library(glue)

# residual corr error 
### optional libraries
#library(TAM)
#library(skimr)
#library(janitor)
# 3116259
# nohup quarto render LSASSR.qmd --to html &> render_lsas.out & 

### some commands exist in multiple packages, here we define preferred ones that are frequently used
select <- dplyr::select
count <- dplyr::count
recode <- car::recode
rename <- dplyr::rename

path_prim <- '/srv/projects/nils/study4rasch'
path2 <- '/Volumes/projects/k8_CPF_Kaldo/Data/Lärande Maskiner/Nils/Study4data'
running_machine = Sys.info()[['sysname']]
path = ifelse(running_machine!='Linux',path2,path_prim)
set_mywd_path = ifelse(running_machine!='Linux','./study4rasch/rasch_measures','./rasch_measures')
n_cores =ifelse(running_machine!='Linux',1,8)

tryCatch({setwd(set_mywd_path)}, error = function(set_mywd_path){print('already in right directory')})
[1] "already in right directory"
Code
source('settings.R') # containing item labels 
source('mod_easyRasch_func.R') # modified functions + added

2 Importing data

Code
### import data
df_raw <- read.csv(file=file.path(path,'data','raw_data','outcome.csv')) #

### Clean data 
source("preprocess.R")
df <- preprocess_data(df_raw)

# items to use 
items_to_use <- 'LSAS.SR' # options are #MADRS.S, LSAS.SR, PDSS.SR
itemlabels <- itemlabels %>% 
  as_tibble() %>%
  filter(str_detect(itemnr, items_to_use))


# DIF+aux variables to use 
# DIF not used 'marital_status','children', 'working'
dif_variables <- c('Patient','Treatment','sex','age','TreatmentAccessStart','education')

### Make a backup of the dataframe, in case you need to revert changes at some point
df.all <- df

print(itemlabels)
# A tibble: 48 × 2
   itemnr     item                     
   <chr>      <chr>                    
 1 LSAS.SR_1a phone anxiety            
 2 LSAS.SR_1b phone avoid              
 3 LSAS.SR_2a small group anxiety      
 4 LSAS.SR_2b small group avoid        
 5 LSAS.SR_3a eat public anxiety       
 6 LSAS.SR_3b eat public avoid         
 7 LSAS.SR_4a drink public anxiety     
 8 LSAS.SR_4b drink public avoid       
 9 LSAS.SR_5a talking authority anxiety
10 LSAS.SR_5b talking authority avoid  
# ℹ 38 more rows

3 Checking missing

Code
itemStart <- items_to_use
out = RImissing_mod(df,itemStart,facet="Time")
print(out)

As we see here LSAS.SR is not used for all conditions over the course of their treatments. However during screening they are. We start by showing all timepoints, to draw targeting plots.

3.1 Remove missing

Code
##### Before filtering out participants, you should check the missing data structure using RImissing() and RImissingP()

# If you want to include participants with missing data, input the minimum number of items responses that a participant should have to be included in the analysis:
min.responses <- 4 # In our case if they have missing on one item all items for that time are missing. 

df_save <- df
# Select the variables we will work with, and filter out respondents with missing data
df <- df %>% 
  select(all_of(c(dif_variables,"Time",itemlabels$itemnr))) %>%  # v
  filter(rowSums(is.na(select(.,all_of(itemlabels$itemnr)))) < min.responses)

4 Create DIF variables

Code
#---- Create DIF variables----
  
# DIF variables into vectors, recoded as factors since DIF functions need this
# these could also be stored in its own dataframe (not a tibble) instead of as vectors
# Named vector for the new types

type_transform <- c(Treatment = "factor", sex = "factor", age = "numeric",
                    TreatmentAccessStart ="integer",education="factor",Time='factor')

# Transform columns based on the named vector
dif <- df %>%
  mutate(across(names(type_transform), ~ switch(type_transform[which(names(type_transform) == cur_column())], 
                                               "integer" = as.integer(.), 
                                               "character" = as.character(.),
                                               "factor" = as.factor(.), 
                                               "numeric" = as.numeric(.)))) %>%
                                               as.data.frame(.) %>%
                                               select(!all_of(itemlabels$itemnr))


# then remove them from dataframe, since we need a dataframe with only item data for the Rasch analyses
df <- df %>% select(all_of(c("Time",itemlabels$itemnr))) # add time here ? 
dfnotime <- df %>% select(!Time)
source("RISE_theme.R")

5 Demographics descriptives

Code
dif_spec <- dif %>% filter(Time=='SCREEN') %>% select(!all_of(c("Time","Patient")))
summary(dif_spec)
# RIdemographics(dif_spec,'Treatment') <- function crashes TODO make own 
 Treatment  sex           age       TreatmentAccessStart         education   
 MDD:2708   F:3700   Min.   :18.0   Min.   :2008         Primary      : 460  
 PD :1507   M:2270   1st Qu.:26.0   1st Qu.:2012         Secondary    :2905  
 SAD:1755            Median :33.0   Median :2014         Postsecondary:2605  
                     Mean   :35.2   Mean   :2014                             
                     3rd Qu.:42.0   3rd Qu.:2017                             
                     Max.   :84.0   Max.   :2019

6 Overall number of responses

Code
# Collapsed 
RIallresp(dfnotime)
# Seperate 
RIallresp_over_times <- df %>% # 
  split(.$Time) %>% # split the data 
  map(~ RIallresp(.x %>% dplyr::select(!Time))) #+ labs(title = .x$Time)) # create separate for each time

# make nice later 
RI_allresp_kable_grid = combine_kables_grid(RIallresp_over_times,cols=3)
RI_allresp_kable_grid
Response category
Number of responses
Percent
0
319302
29.8
1
353013
32.9
2
229850
21.4
3
170299
15.9
x
SCREEN.Response category SCREEN.Number of responses SCREEN.Percent PRE.Response category PRE.Number of responses PRE.Percent WEEK01.Response category WEEK01.Number of responses WEEK01.Percent
0 107419 37.5 0 17550 22.7 0 16590 23.5
1 88404 30.9 1 21933 28.3 1 21555 30.5
2 52737 18.4 2 19674 25.4 2 17594 24.9
3 38000 13.3 3 18219 23.5 3 14869 21.1
WEEK02.Response category WEEK02.Number of responses WEEK02.Percent WEEK03.Response category WEEK03.Number of responses WEEK03.Percent WEEK04.Response category WEEK04.Number of responses WEEK04.Percent
0 17496 23.7 0 18117 24.9 0 18130 25.5
1 23433 31.8 1 23689 32.6 1 23868 33.6
2 18028 24.5 2 17184 23.6 2 16563 23.3
3 14723 20.0 3 13682 18.8 3 12527 17.6
WEEK05.Response category WEEK05.Number of responses WEEK05.Percent WEEK06.Response category WEEK06.Number of responses WEEK06.Percent WEEK07.Response category WEEK07.Number of responses WEEK07.Percent
0 17827 26.9 0 17209 27.2 0 17083 28.2
1 22505 33.9 1 21904 34.6 1 21632 35.7
2 14965 22.6 2 14034 22.2 2 13193 21.7
3 11039 16.6 3 10069 15.9 3 8764 14.4
WEEK08.Response category WEEK08.Number of responses WEEK08.Percent WEEK09.Response category WEEK09.Number of responses WEEK09.Percent WEEK10.Response category WEEK10.Number of responses WEEK10.Percent
0 17056 29.3 0 16990 30.6 0 16481 31.5
1 20934 35.9 1 20218 36.5 1 19332 37.0
2 12323 21.1 2 11288 20.4 2 10333 19.8
3 7959 13.7 3 6944 12.5 3 6126 11.7
POST.Response category POST.Number of responses POST.Percent " " " "
0 21354 33.2
1 23606 36.7
2 11934 18.6
3 7378 11.5

7 Descriptives of raw data

Paste descriptive part here after rasch itterations

8 Timepoint decision

Due to the amount of data across timepoints targeting will first be inspected, and the best fitting timepoint will be chosen based on targeting, which in turn will inform the rest of the analyses.

8.1 Targeting

Code
# increase fig-height above as needed, if you have many items og. value was 5. 
#RItargeting(dfnotime)

require(patchwork)
targeting_time_plots <- ggplots_with_spec_func_over_time(
  df,func_call = RItargeting,title_all='',
  blankx=FALSE,colsplot = 3,rowsplot=5,return_list_plots=TRUE)
good_layout_targeting_plots <- wrap_plots(targeting_time_plots, ncol = 3) + plot_layout(guides= "collect")
#print(good_layout_targeting_plots)
ggsave(
  filename = paste0("./plots/",items_to_use,"_targeting_over_time.png"),
  plot = good_layout_targeting_plots,
  width = 20,  # Increase width (in inches)
  height = 60, # Increase height (in inches)
  dpi = 300,    # High resolution
  limitsize=FALSE
)
print(good_layout_targeting_plots)

Pre has very good targeting looks promising. We also note that this is only for patient in treatment for social anxiety disorder (no other treatment-conditions are mixed in PRE). We doublecheck how much data we have for each threshold. (Recomm. 20+).

8.2 Number of responses per threshhold

Code
dataframen4 <- df %>% filter(Time=="WEEK02") %>% select(!Time)
dfthreshcount = sapply(dataframen4, function(column) table(column))
print(dfthreshcount)
#dfthreshcount[dfthreshcount<20]

8.3 Timepoint conclusion

Based on the above we move forward with the PRE timepoint.

Code
df_pre <- df %>% filter(Time=='PRE') %>% select(!Time) #%>% sample_n(800)

9 Mokken part 1

Its a large scale, with paired items.

Code
require(mokken)
lsasmok <- aisp(df_pre, verbose = TRUE)

SCALE 1

Item  17 :  LSAS.SR_9a            Scale 1  H =  0.92 
Item  18 :  LSAS.SR_9b            Scale 1  H =  0.92 
Item  15 :  LSAS.SR_8a            Scale 1  H =  0.7
Item  16 :  LSAS.SR_8b            Scale 1  H =  0.69
Item  34 :  LSAS.SR_17b           Scale 1  H =  0.59
Item  33 :  LSAS.SR_17a           Scale 1  H =  0.54
Item  27 :  LSAS.SR_14a           Scale 1  H =  0.49
Item  28 :  LSAS.SR_14b           Scale 1  H =  0.47
Item  31 :  LSAS.SR_16a           Scale 1  H =  0.45
Item  29 :  LSAS.SR_15a           Scale 1  H =  0.43
Item   4 :  LSAS.SR_2b            Scale 1  H =  0.42
Item   3 :  LSAS.SR_2a            Scale 1  H =  0.42
Item  30 :  LSAS.SR_15b           Scale 1  H =  0.41
Item  32 :  LSAS.SR_16b           Scale 1  H =  0.41
Item  39 :  LSAS.SR_20a           Scale 1  H =  0.41
Item  40 :  LSAS.SR_20b           Scale 1  H =  0.41
Item  12 :  LSAS.SR_6b            Scale 1  H =  0.41
Item  11 :  LSAS.SR_6a            Scale 1  H =  0.41
Item  21 :  LSAS.SR_11a           Scale 1  H =  0.4
Item  24 :  LSAS.SR_12b           Scale 1  H =  0.39
Item  23 :  LSAS.SR_12a           Scale 1  H =  0.39
Item  22 :  LSAS.SR_11b           Scale 1  H =  0.39
Item  35 :  LSAS.SR_18a           Scale 1  H =  0.39
Item  36 :  LSAS.SR_18b           Scale 1  H =  0.38
Item  10 :  LSAS.SR_5b            Scale 1  H =  0.38
Item  37 :  LSAS.SR_19a           Scale 1  H =  0.38
Item  38 :  LSAS.SR_19b           Scale 1  H =  0.38
Item   9 :  LSAS.SR_5a            Scale 1  H =  0.37
Item  20 :  LSAS.SR_10b           Scale 1  H =  0.37
Item  19 :  LSAS.SR_10a           Scale 1  H =  0.37
Item  13 :  LSAS.SR_7a            Scale 1  H =  0.37
Item  14 :  LSAS.SR_7b            Scale 1  H =  0.36
Item  43 :  LSAS.SR_22a           Scale 1  H =  0.36
Item  47 :  LSAS.SR_24a           Scale 1  H =  0.36
Item   1 :  LSAS.SR_1a            Scale 1  H =  0.36
Item  44 :  LSAS.SR_22b           Scale 1  H =  0.36
Item   2 :  LSAS.SR_1b            Scale 1  H =  0.35
Item  48 :  LSAS.SR_24b           Scale 1  H =  0.35
Scale  1  is completed. No items left such that Hi >  0.3 .

SCALE 2

Item  41 :  LSAS.SR_21a           Scale 2  H =  0.91 
Item  42 :  LSAS.SR_21b           Scale 2  H =  0.91 
Item  46 :  LSAS.SR_23b           Scale 2  H =  0.59
Item  45 :  LSAS.SR_23a           Scale 2  H =  0.57
Scale  2  is completed. No items left such that Hi >  0.3 .

SCALE 3

Item   5 :  LSAS.SR_3a            Scale 3  H =  0.9 
Item   6 :  LSAS.SR_3b            Scale 3  H =  0.9 
Item   7 :  LSAS.SR_4a            Scale 3  H =  0.74
Item   8 :  LSAS.SR_4b            Scale 3  H =  0.73
Item  25 :  LSAS.SR_13a           Scale 3  H =  0.56
Item  26 :  LSAS.SR_13b           Scale 3  H =  0.51
Scale  3  is completed. No items left with Hij => 0

SCALE 4

Less than two items left. PROCEDURE STOPS
Code
first_scale = names(lsasmok[lsasmok[,1]==1,])
df_s1 <- df_pre %>% select(all_of(first_scale))

We see that while 3 scales are identified the predominant is the one is large. Moving on with this one which also contains the core symptoms.

Code
scaleH <-  coefH(df_s1,results=FALSE)
threshold <- 0.35
H_df <- as.data.frame(scaleH$Hi[,1]) %>% rename('H'='scaleH$Hi[, 1]') %>% mutate(H=as.numeric(H),item = rownames(.))
kbl_rise(scaleH$Hi)
Item H se
LSAS.SR_1a 0.338 (0.014)
LSAS.SR_1b 0.319 (0.014)
LSAS.SR_2a 0.356 (0.014)
LSAS.SR_2b 0.398 (0.012)
LSAS.SR_5a 0.318 (0.014)
LSAS.SR_5b 0.354 (0.013)
LSAS.SR_6a 0.237 (0.023)
LSAS.SR_6b 0.278 (0.017)
LSAS.SR_7a 0.339 (0.014)
LSAS.SR_7b 0.328 (0.014)
LSAS.SR_8a 0.361 (0.013)
LSAS.SR_8b 0.359 (0.013)
LSAS.SR_9a 0.316 (0.015)
LSAS.SR_9b 0.326 (0.017)
LSAS.SR_10a 0.379 (0.013)
LSAS.SR_10b 0.382 (0.013)
LSAS.SR_11a 0.439 (0.012)
LSAS.SR_11b 0.427 (0.012)
LSAS.SR_12a 0.420 (0.012)
LSAS.SR_12b 0.424 (0.012)
LSAS.SR_14a 0.371 (0.013)
LSAS.SR_14b 0.391 (0.012)
LSAS.SR_15a 0.339 (0.016)
LSAS.SR_15b 0.345 (0.014)
LSAS.SR_16a 0.356 (0.016)
LSAS.SR_16b 0.346 (0.015)
LSAS.SR_17a 0.253 (0.016)
LSAS.SR_17b 0.307 (0.020)
LSAS.SR_18a 0.369 (0.014)
LSAS.SR_18b 0.354 (0.014)
LSAS.SR_19a 0.357 (0.013)
LSAS.SR_19b 0.344 (0.014)
LSAS.SR_20a 0.300 (0.015)
LSAS.SR_20b 0.314 (0.014)
LSAS.SR_22a 0.365 (0.013)
LSAS.SR_22b 0.327 (0.014)
LSAS.SR_24a 0.359 (0.013)
LSAS.SR_24b 0.312 (0.014)
Code
remove <- H_df[H_df[['H']] < threshold,'item'] 
keep <- H_df[H_df[['H']] >= threshold, 'item']  

df_ls <- df_s1 %>% select(all_of(keep))

We see many items around 0.3, 0.35 clips the number of items in half.

Code
scaleH2 <-  coefH(df_ls,results=FALSE)
kbl_rise(scaleH2$Hi)
Item H se
LSAS.SR_2a 0.383 (0.015)
LSAS.SR_2b 0.419 (0.014)
LSAS.SR_5b 0.380 (0.015)
LSAS.SR_8a 0.378 (0.015)
LSAS.SR_8b 0.378 (0.015)
LSAS.SR_10a 0.452 (0.013)
LSAS.SR_10b 0.452 (0.013)
LSAS.SR_11a 0.525 (0.012)
LSAS.SR_11b 0.505 (0.012)
LSAS.SR_12a 0.498 (0.012)
LSAS.SR_12b 0.489 (0.013)
LSAS.SR_14a 0.405 (0.014)
LSAS.SR_14b 0.423 (0.014)
LSAS.SR_16a 0.338 (0.018)
LSAS.SR_18a 0.434 (0.015)
LSAS.SR_18b 0.411 (0.015)
LSAS.SR_19a 0.389 (0.014)
LSAS.SR_22a 0.395 (0.015)
LSAS.SR_24a 0.393 (0.015)
Code
require(lavaan)
items_from_mokken <- names(df_ls)
f1 <- paste0('efa("efa")*f1 =~',
      paste0(items_from_mokken,collapse=' + '))

# 2-factor model
f2 <- paste0('efa("efa")*f1 + efa("efa")*f2 =~',
      paste0(items_from_mokken,collapse=' + '))



# 3-factor
f3 <- paste0('efa("efa")*f1 + efa("efa")*f2 + efa("efa")*f3 =~',
      paste0(items_from_mokken,collapse=' + '))


# 4-factor
f4 <- paste0('efa("efa")*f1 + efa("efa")*f2 + efa("efa")*f3 + efa("efa")*f4 =~',
      paste0(items_from_mokken,collapse=' + '))


# 5-factor
f5 <- paste0('efa("efa")*f1 + efa("efa")*f2 + efa("efa")*f3 + efa("efa")*f4 + efa("efa")*f5 =~',
      paste0(items_from_mokken,collapse=' + '))

efa_f1 <- 
  cfa(model = f1,
      data = df_ls,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f2 <- 
  cfa(model = f2,
      data = df_ls,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f3 <- 
  cfa(model = f3,
      data = df_ls,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f4 <- 
  cfa(model = f4,
      data = df_ls,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
efa_f5 <- 
  cfa(model = f5,
      data = df_ls,
      rotation = "oblimin",
      estimator = "WLSMV",
      ordered = TRUE)
Code
fit_metrics_scaled <- c("chisq.scaled", "df", "pvalue.scaled", 
                        "cfi.scaled", "tli.scaled", "rmsea.scaled", 
                        "rmsea.ci.lower.scaled","rmsea.ci.upper.scaled",
                        "srmr")


rbind(
  fitmeasures(efa_f1, fit_metrics_scaled),
  fitmeasures(efa_f2, fit_metrics_scaled),
  fitmeasures(efa_f3, fit_metrics_scaled),
  fitmeasures(efa_f4, fit_metrics_scaled),
  fitmeasures(efa_f5, fit_metrics_scaled)
  ) %>% 
  as.data.frame() %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  rename(Chi2.scaled = chisq.scaled,
         p.scaled = pvalue.scaled,
         CFI.scaled = cfi.scaled,
         TLI.scaled = tli.scaled,
         RMSEA.scaled = rmsea.scaled,
         CI_low.scaled = rmsea.ci.lower.scaled,
         CI_high.scaled = rmsea.ci.upper.scaled,
         SRMR = srmr) %>% 
  add_column(Model = paste0(1:5,"-factor"), .before = "Chi2.scaled") %>% 
  knitr::kable()
Model Chi2.scaled df p.scaled CFI.scaled TLI.scaled RMSEA.scaled CI_low.scaled CI_high.scaled SRMR
1-factor 12024.366 152 0 0.790 0.763 0.220 0.217 0.224 0.148
2-factor 8011.959 134 0 0.860 0.822 0.191 0.187 0.195 0.114
3-factor 5343.899 117 0 0.907 0.865 0.167 0.163 0.170 0.085
4-factor 3371.339 101 0 0.942 0.902 0.142 0.138 0.146 0.059
5-factor 2105.495 86 0 0.964 0.929 0.121 0.116 0.125 0.042
Code
standardizedsolution(efa_f1) %>% 
  filter(op == "=~") %>% 
  mutate(item  = str_remove(rhs, "LSAS.SR_"),
         factor = str_remove(lhs, "f"))
   lhs op         rhs est.std    se       z pvalue ci.lower ci.upper item
1   f1 =~  LSAS.SR_2a   0.649 0.014  45.278      0    0.621    0.677   2a
2   f1 =~  LSAS.SR_2b   0.687 0.012  55.455      0    0.663    0.711   2b
3   f1 =~  LSAS.SR_5b   0.535 0.017  30.954      0    0.501    0.568   5b
4   f1 =~  LSAS.SR_8a   0.725 0.012  61.468      0    0.701    0.748   8a
5   f1 =~  LSAS.SR_8b   0.728 0.012  62.605      0    0.706    0.751   8b
6   f1 =~ LSAS.SR_10a   0.853 0.007 117.629      0    0.839    0.867  10a
7   f1 =~ LSAS.SR_10b   0.856 0.007 116.441      0    0.842    0.870  10b
8   f1 =~ LSAS.SR_11a   0.871 0.006 141.763      0    0.859    0.883  11a
9   f1 =~ LSAS.SR_11b   0.847 0.007 121.853      0    0.833    0.861  11b
10  f1 =~ LSAS.SR_12a   0.873 0.006 139.445      0    0.860    0.885  12a
11  f1 =~ LSAS.SR_12b   0.855 0.007 126.570      0    0.842    0.868  12b
12  f1 =~ LSAS.SR_14a   0.700 0.012  56.776      0    0.676    0.725  14a
13  f1 =~ LSAS.SR_14b   0.717 0.012  59.779      0    0.694    0.741  14b
14  f1 =~ LSAS.SR_16a   0.488 0.021  23.495      0    0.448    0.529  16a
15  f1 =~ LSAS.SR_18a   0.791 0.010  81.528      0    0.772    0.810  18a
16  f1 =~ LSAS.SR_18b   0.778 0.010  76.944      0    0.759    0.798  18b
17  f1 =~ LSAS.SR_19a   0.550 0.016  33.786      0    0.519    0.582  19a
18  f1 =~ LSAS.SR_22a   0.561 0.017  33.880      0    0.528    0.593  22a
19  f1 =~ LSAS.SR_24a   0.562 0.017  33.422      0    0.529    0.595  24a
   factor
1       1
2       1
3       1
4       1
5       1
6       1
7       1
8       1
9       1
10      1
11      1
12      1
13      1
14      1
15      1
16      1
17      1
18      1
19      1
Code
modificationIndices(efa_f1,
                    standardized = T) %>% 
  as.data.frame(row.names = NULL) %>% 
  filter(mi > 50) %>% 
  arrange(desc(mi)) %>% 
  mutate(across(where(is.numeric),~ round(.x, 3))) %>%
  knitr::kable()
lhs op rhs mi epc sepc.lv sepc.all sepc.nox
LSAS.SR_8a ~~ LSAS.SR_8b 3519.012 -0.698 -0.698 -1.478 -1.478
LSAS.SR_18a ~~ LSAS.SR_18b 2890.232 -0.620 -0.620 -1.613 -1.613
LSAS.SR_10a ~~ LSAS.SR_10b 2519.445 -0.543 -0.543 -2.010 -2.010
LSAS.SR_14a ~~ LSAS.SR_14b 2089.320 -0.566 -0.566 -1.138 -1.138
LSAS.SR_2a ~~ LSAS.SR_2b 1566.049 -0.515 -0.515 -0.932 -0.932
LSAS.SR_12a ~~ LSAS.SR_12b 592.154 -0.260 -0.260 -1.025 -1.025
LSAS.SR_11a ~~ LSAS.SR_11b 366.040 -0.207 -0.207 -0.794 -0.794
LSAS.SR_22a ~~ LSAS.SR_24a 209.155 -0.286 -0.286 -0.418 -0.418
LSAS.SR_11a ~~ LSAS.SR_12a 190.124 -0.155 -0.155 -0.644 -0.644
LSAS.SR_8a ~~ LSAS.SR_11b 171.436 0.339 0.339 0.926 0.926
LSAS.SR_2a ~~ LSAS.SR_16a 167.167 -0.298 -0.298 -0.448 -0.448
LSAS.SR_11b ~~ LSAS.SR_12b 166.373 -0.148 -0.148 -0.538 -0.538
LSAS.SR_8a ~~ LSAS.SR_12b 159.909 0.330 0.330 0.922 0.922
LSAS.SR_8b ~~ LSAS.SR_12a 158.677 0.334 0.334 0.999 0.999
LSAS.SR_10a ~~ LSAS.SR_14b 157.339 0.337 0.337 0.927 0.927
LSAS.SR_10b ~~ LSAS.SR_14a 156.634 0.327 0.327 0.886 0.886
LSAS.SR_8b ~~ LSAS.SR_11a 145.805 0.314 0.314 0.931 0.931
LSAS.SR_2a ~~ LSAS.SR_10b 144.966 0.329 0.329 0.837 0.837
LSAS.SR_10a ~~ LSAS.SR_14a 142.428 0.301 0.301 0.808 0.808
LSAS.SR_8b ~~ LSAS.SR_10a 141.650 0.306 0.306 0.856 0.856
LSAS.SR_8a ~~ LSAS.SR_12a 138.018 0.299 0.299 0.888 0.888
LSAS.SR_8a ~~ LSAS.SR_10b 136.560 0.300 0.300 0.841 0.841
LSAS.SR_2b ~~ LSAS.SR_10a 135.604 0.310 0.310 0.816 0.816
LSAS.SR_8a ~~ LSAS.SR_11a 133.599 0.281 0.281 0.828 0.828
LSAS.SR_10b ~~ LSAS.SR_18a 131.184 0.279 0.279 0.882 0.882
LSAS.SR_8b ~~ LSAS.SR_11b 122.781 0.277 0.277 0.762 0.762
LSAS.SR_10a ~~ LSAS.SR_18b 121.475 0.268 0.268 0.816 0.816
LSAS.SR_8b ~~ LSAS.SR_12b 118.823 0.275 0.275 0.774 0.774
LSAS.SR_2a ~~ LSAS.SR_10a 115.206 0.288 0.288 0.724 0.724
LSAS.SR_12b ~~ LSAS.SR_18a 114.896 0.249 0.249 0.785 0.785
LSAS.SR_8a ~~ LSAS.SR_10a 114.064 0.265 0.265 0.736 0.736
LSAS.SR_12a ~~ LSAS.SR_18b 113.963 0.255 0.255 0.833 0.833
LSAS.SR_8a ~~ LSAS.SR_18b 113.168 0.278 0.278 0.641 0.641
LSAS.SR_2b ~~ LSAS.SR_10b 108.883 0.265 0.265 0.704 0.704
LSAS.SR_10b ~~ LSAS.SR_14b 108.282 0.263 0.263 0.731 0.731
LSAS.SR_8b ~~ LSAS.SR_10b 105.691 0.256 0.256 0.722 0.722
LSAS.SR_10a ~~ LSAS.SR_18a 105.444 0.235 0.235 0.734 0.734
LSAS.SR_10b ~~ LSAS.SR_12a 100.768 0.208 0.208 0.825 0.825
LSAS.SR_11a ~~ LSAS.SR_18b 97.305 0.226 0.226 0.732 0.732
LSAS.SR_10b ~~ LSAS.SR_18b 96.398 0.235 0.235 0.724 0.724
LSAS.SR_8b ~~ LSAS.SR_18a 96.049 0.258 0.258 0.615 0.615
LSAS.SR_2b ~~ LSAS.SR_16a 95.604 -0.236 -0.236 -0.372 -0.372
LSAS.SR_12b ~~ LSAS.SR_14a 95.378 0.245 0.245 0.662 0.662
LSAS.SR_11b ~~ LSAS.SR_14a 93.792 0.234 0.234 0.617 0.617
LSAS.SR_12a ~~ LSAS.SR_18a 92.359 0.215 0.215 0.720 0.720
LSAS.SR_14a ~~ LSAS.SR_18b 92.150 0.247 0.247 0.550 0.550
LSAS.SR_12a ~~ LSAS.SR_14b 91.151 0.240 0.240 0.704 0.704
LSAS.SR_2b ~~ LSAS.SR_18a 87.636 0.242 0.242 0.544 0.544
LSAS.SR_10a ~~ LSAS.SR_12b 86.460 0.195 0.195 0.719 0.719
LSAS.SR_8b ~~ LSAS.SR_18b 86.234 0.239 0.239 0.557 0.557
LSAS.SR_11b ~~ LSAS.SR_18a 82.168 0.204 0.204 0.627 0.627
LSAS.SR_12b ~~ LSAS.SR_18b 73.257 0.195 0.195 0.600 0.600
LSAS.SR_8a ~~ LSAS.SR_18a 71.816 0.212 0.212 0.502 0.502
LSAS.SR_12a ~~ LSAS.SR_14a 70.458 0.202 0.202 0.579 0.579
LSAS.SR_14b ~~ LSAS.SR_18a 68.976 0.221 0.221 0.519 0.519
LSAS.SR_11a ~~ LSAS.SR_14b 68.145 0.197 0.197 0.575 0.575
LSAS.SR_10a ~~ LSAS.SR_12a 67.308 0.158 0.158 0.618 0.618
LSAS.SR_2a ~~ LSAS.SR_8b 65.897 0.225 0.225 0.432 0.432
LSAS.SR_2a ~~ LSAS.SR_18b 64.129 0.215 0.215 0.450 0.450
LSAS.SR_11a ~~ LSAS.SR_18a 63.845 0.177 0.177 0.589 0.589
LSAS.SR_14a ~~ LSAS.SR_18a 59.133 0.191 0.191 0.437 0.437
LSAS.SR_11b ~~ LSAS.SR_14b 57.309 0.177 0.177 0.479 0.479
LSAS.SR_10b ~~ LSAS.SR_12b 55.604 0.142 0.142 0.530 0.530
LSAS.SR_14b ~~ LSAS.SR_18b 52.307 0.186 0.186 0.426 0.426
LSAS.SR_2b ~~ LSAS.SR_8a 52.296 0.186 0.186 0.370 0.370
LSAS.SR_2b ~~ LSAS.SR_18b 52.218 0.178 0.178 0.391 0.391
LSAS.SR_10b ~~ LSAS.SR_16a 51.142 0.216 0.216 0.479 0.479

Residual correlations between item pairs are strong.

Code
#item  = str_replace_all(str_remove(rhs, "LSAS.SR_"),c("a" = "1", "b" = "2")) %>% as.double()
standardizedsolution(efa_f2) %>% 
  filter(op == "=~") %>% 
  mutate(item  = str_remove(rhs, "LSAS.SR_"),
         factor = str_remove(lhs, "f")) %>% 
  # plot
  ggplot(aes(x = est.std, xmin = ci.lower, xmax = ci.upper, y = item)) +
    annotate(geom = "rect",
           xmin = -1, xmax = 1,
           ymin = -Inf, ymax = Inf,
           fill = "grey90") +
  annotate(geom = "rect",
           xmin = -0.7, xmax = 0.7,
           ymin = -Inf, ymax = Inf,
           fill = "grey93") +
  annotate(geom = "rect",
           xmin = -0.3, xmax = 0.3,
           ymin = -Inf, ymax = Inf,
           fill = "grey96") +
  geom_vline(xintercept = 0, color = "white") +
  geom_pointrange(aes(alpha = abs(est.std) < 0.3),
                  fatten = 10)+
  geom_text(aes(label = item, color = abs(est.std) < 0.3),
            size = 4) +
  scale_color_manual(values = c("white", "transparent")) +
  scale_alpha_manual(values = c(1, 1/3)) +
  scale_x_continuous(expand = c(0, 0), limits = c(-1, 1),
                     breaks = c(-1, -0.7, -0.3, 0, 0.3, 0.7, 1),
                     labels = c("-1", "-.7", "-.3", "0", ".3", ".7", "1")) +
  ggtitle("Factor loadings for the 3-factor model") +
  theme(legend.position = "none") +
  facet_wrap(~ factor, labeller = label_both)

Code
#item  = str_replace_all(str_remove(rhs, "LSAS.SR_"),c("a" = "1", "b" = "2")) %>% as.double()
standardizedsolution(efa_f3) %>% 
  filter(op == "=~") %>% 
  mutate(item  = str_remove(rhs, "LSAS.SR_"),
         factor = str_remove(lhs, "f")) %>% 
  # plot
  ggplot(aes(x = est.std, xmin = ci.lower, xmax = ci.upper, y = item)) +
    annotate(geom = "rect",
           xmin = -1, xmax = 1,
           ymin = -Inf, ymax = Inf,
           fill = "grey90") +
  annotate(geom = "rect",
           xmin = -0.7, xmax = 0.7,
           ymin = -Inf, ymax = Inf,
           fill = "grey93") +
  annotate(geom = "rect",
           xmin = -0.3, xmax = 0.3,
           ymin = -Inf, ymax = Inf,
           fill = "grey96") +
  geom_vline(xintercept = 0, color = "white") +
  geom_pointrange(aes(alpha = abs(est.std) < 0.3),
                  fatten = 10)+
  geom_text(aes(label = item, color = abs(est.std) < 0.3),
            size = 4) +
  scale_color_manual(values = c("white", "transparent")) +
  scale_alpha_manual(values = c(1, 1/3)) +
  scale_x_continuous(expand = c(0, 0), limits = c(-1, 1),
                     breaks = c(-1, -0.7, -0.3, 0, 0.3, 0.7, 1),
                     labels = c("-1", "-.7", "-.3", "0", ".3", ".7", "1")) +
  ggtitle("Factor loadings for the 3-factor model") +
  theme(legend.position = "none") +
  facet_wrap(~ factor, labeller = label_both)

We see that the EFA essentially captures the item pairs of each question. Even constraining the factors two 2, does not confirm that fear and avoidance load on different factors. EFA is thus not very informative except that the items are not unidimensional. And we move on with the 19 items, and with the a/b distinction in mind - ergo that they have high residual correlations - aim to remove atleast 1 of each item pair. In regards to the mokken part due note that the talking to new people and being with strangers have the higest H.

10 Rasch analysis 1

Code
RIlistItemsMargin(df_ls, fontsize = 12)
itemnr item
LSAS.SR_2a small group anxiety
LSAS.SR_2b small group avoid
LSAS.SR_5b talking authority avoid
LSAS.SR_8a work obs anxiety
LSAS.SR_8b work obs avoid
LSAS.SR_10a call new anxiety
LSAS.SR_10b call new avoid
LSAS.SR_11a talk new anxiety
LSAS.SR_11b talk new avoid
LSAS.SR_12a stranger anxiety
LSAS.SR_12b stranger avoid
LSAS.SR_14a enter room anxiety
LSAS.SR_14b enter room avoid
LSAS.SR_16a speaking up anxiety
LSAS.SR_18a disagreement anxiety
LSAS.SR_18b disagreement avoid
LSAS.SR_19a eye contact anxiety
LSAS.SR_22a returning goods anxiety
LSAS.SR_24a resisting sales anxiety
Code
RIitemfit(df_ls, cutoff = "Smith98")
Item InfitMSQ Location 1 ± 2 / √n
LSAS.SR_2a 1.077 -0.64 [0.95, 1.05]
LSAS.SR_2b 0.992 0.15 [0.95, 1.05]
LSAS.SR_5b 1.117 0.08 [0.95, 1.05]
LSAS.SR_8a 1.143 0.17 [0.95, 1.05]
LSAS.SR_8b 1.166 0.74 [0.95, 1.05]
LSAS.SR_10a 0.941 -0.08 [0.95, 1.05]
LSAS.SR_10b 0.952 0.32 [0.95, 1.05]
LSAS.SR_11a 0.693 -0.24 [0.95, 1.05]
LSAS.SR_11b 0.748 0.04 [0.95, 1.05]
LSAS.SR_12a 0.774 -0.24 [0.95, 1.05]
LSAS.SR_12b 0.798 0.08 [0.95, 1.05]
LSAS.SR_14a 1.039 -0.23 [0.95, 1.05]
LSAS.SR_14b 1.026 0.64 [0.95, 1.05]
LSAS.SR_16a 1.259 -1.87 [0.95, 1.05]
LSAS.SR_18a 0.969 -0.67 [0.95, 1.05]
LSAS.SR_18b 1.042 -0.58 [0.95, 1.05]
LSAS.SR_19a 1.132 0.58 [0.95, 1.05]
LSAS.SR_22a 1.134 0.66 [0.95, 1.05]
LSAS.SR_24a 1.159 1.07 [0.95, 1.05]
Note:
MSQ values based on conditional estimation (n = 1612 complete cases).
Code
# Getting error for estimating the simfit for LSAS. 
# Getting same error for week 2 and week 1 
#df_week02 <- df %>% filter(Time=='WEEK02') %>% select(!Time) 
simfit1 <- RIgetfit(df_ls, iterations = 300, cpu = n_cores)  # 

RIitemfit(df_ls, simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2a 1.077 [0.934, 1.086] 1.068 [0.913, 1.126] no misfit no misfit -0.64
LSAS.SR_2b 0.992 [0.93, 1.085] 0.995 [0.896, 1.1] no misfit no misfit 0.15
LSAS.SR_5b 1.117 [0.93, 1.068] 1.144 [0.919, 1.08] 0.049 0.064 0.08
LSAS.SR_8a 1.143 [0.925, 1.069] 1.17 [0.923, 1.07] 0.074 0.1 0.17
LSAS.SR_8b 1.166 [0.932, 1.075] 1.189 [0.921, 1.088] 0.091 0.101 0.74
LSAS.SR_10a 0.941 [0.934, 1.079] 0.934 [0.927, 1.072] no misfit no misfit -0.08
LSAS.SR_10b 0.952 [0.935, 1.068] 0.956 [0.923, 1.077] no misfit no misfit 0.32
LSAS.SR_11a 0.693 [0.913, 1.091] 0.688 [0.896, 1.132] 0.22 0.208 -0.24
LSAS.SR_11b 0.748 [0.929, 1.075] 0.739 [0.906, 1.152] 0.181 0.167 0.04
LSAS.SR_12a 0.774 [0.934, 1.067] 0.758 [0.913, 1.076] 0.16 0.155 -0.24
LSAS.SR_12b 0.798 [0.915, 1.064] 0.789 [0.909, 1.091] 0.117 0.12 0.08
LSAS.SR_14a 1.039 [0.926, 1.088] 1.024 [0.913, 1.106] no misfit no misfit -0.23
LSAS.SR_14b 1.026 [0.924, 1.081] 1.002 [0.91, 1.094] no misfit no misfit 0.64
LSAS.SR_16a 1.259 [0.928, 1.085] 1.23 [0.91, 1.094] 0.174 0.136 -1.87
LSAS.SR_18a 0.969 [0.942, 1.081] 0.965 [0.937, 1.1] no misfit no misfit -0.67
LSAS.SR_18b 1.042 [0.925, 1.069] 1.038 [0.916, 1.101] no misfit no misfit -0.58
LSAS.SR_19a 1.132 [0.933, 1.072] 1.142 [0.922, 1.086] 0.06 0.056 0.58
LSAS.SR_22a 1.134 [0.924, 1.077] 1.153 [0.918, 1.097] 0.057 0.056 0.66
LSAS.SR_24a 1.159 [0.931, 1.082] 1.162 [0.913, 1.113] 0.077 0.049 1.07
Note:
MSQ values based on conditional calculations (n = 1612 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RIgetfitPlot(simfit1, df_ls)

Code
#skipped right now 
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 1:4, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[1:4])

### also suggested:
# library(RASCHplot) # install first with `devtools::install_github("ERRTG/RASCHplot")`
# CICCplot(PCM(df),
#          which.item = c(1:4),
#          lower.groups = c(0,7,14,21,28,35),
#          grid.items = TRUE)
Code
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 5:7, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[5:7])

This is severely limited due to the large number of items

Code
Item Observed value Model expected value Absolute difference Adjusted p-value (BH) Statistical significance level Location Relative location
LSAS.SR_2a 0.51 0.54 0.03 0.083 . -0.64 -0.93
LSAS.SR_2b 0.57 0.55 0.02 0.412 0.15 -0.14
LSAS.SR_5b 0.51 0.56 0.05 0.010 ** 0.08 -0.22
LSAS.SR_8a 0.49 0.56 0.07 0.001 ** 0.17 -0.12
LSAS.SR_8b 0.48 0.56 0.08 0.000 *** 0.74 0.45
LSAS.SR_10a 0.60 0.57 0.03 0.051 . -0.08 -0.37
LSAS.SR_10b 0.60 0.57 0.03 0.113 0.32 0.03
LSAS.SR_11a 0.74 0.55 0.19 0.000 *** -0.24 -0.53
LSAS.SR_11b 0.70 0.55 0.15 0.000 *** 0.04 -0.25
LSAS.SR_12a 0.69 0.55 0.14 0.000 *** -0.24 -0.54
LSAS.SR_12b 0.67 0.56 0.11 0.000 *** 0.08 -0.22
LSAS.SR_14a 0.54 0.55 0.01 0.412 -0.23 -0.52
LSAS.SR_14b 0.54 0.56 0.02 0.324 0.64 0.35
LSAS.SR_16a 0.45 0.54 0.09 0.000 *** -1.87 -2.17
LSAS.SR_18a 0.57 0.55 0.02 0.170 -0.67 -0.96
LSAS.SR_18b 0.53 0.56 0.03 0.182 -0.58 -0.87
LSAS.SR_19a 0.50 0.56 0.06 0.000 *** 0.58 0.28
LSAS.SR_22a 0.51 0.57 0.06 0.003 ** 0.66 0.37
LSAS.SR_24a 0.51 0.57 0.06 0.002 ** 1.07 0.78
Code
RIbootRestscore(df_ls,cpu=n_cores,iterations = 500,samplesize=800) # samplesize=600
Item Item-restscore result % of iterations Conditional MSQ infit Relative average item location
LSAS.SR_10a no misfit 73.4 0.94 -0.37
LSAS.SR_10a overfit 26.6 0.94 -0.37
LSAS.SR_10b no misfit 85.2 0.95 0.03
LSAS.SR_10b overfit 14.8 0.95 0.03
LSAS.SR_11a overfit 100.0 0.69 -0.53
LSAS.SR_11b overfit 100.0 0.75 -0.25
LSAS.SR_12a overfit 100.0 0.77 -0.54
LSAS.SR_12b overfit 100.0 0.80 -0.22
LSAS.SR_14a no misfit 99.0 1.04 -0.52
LSAS.SR_14b no misfit 97.6 1.03 0.35
LSAS.SR_16a no misfit 32.2 1.26 -2.17
LSAS.SR_16a underfit 67.8 1.26 -2.17
LSAS.SR_18a no misfit 89.6 0.97 -0.96
LSAS.SR_18a overfit 10.4 0.97 -0.96
LSAS.SR_18b no misfit 94.2 1.04 -0.87
LSAS.SR_18b underfit 5.8 1.04 -0.87
LSAS.SR_19a no misfit 30.2 1.13 0.28
LSAS.SR_19a underfit 69.8 1.13 0.28
LSAS.SR_22a no misfit 56.6 1.13 0.37
LSAS.SR_22a underfit 43.4 1.13 0.37
LSAS.SR_24a no misfit 52.4 1.16 0.78
LSAS.SR_24a underfit 47.6 1.16 0.78
LSAS.SR_2a no misfit 86.2 1.08 -0.93
LSAS.SR_2a underfit 13.8 1.08 -0.93
LSAS.SR_2b no misfit 96.4 0.99 -0.14
LSAS.SR_5b no misfit 66.2 1.12 -0.22
LSAS.SR_5b underfit 33.8 1.12 -0.22
LSAS.SR_8a no misfit 44.6 1.14 -0.12
LSAS.SR_8a underfit 55.4 1.14 -0.12
LSAS.SR_8b no misfit 20.0 1.17 0.45
LSAS.SR_8b underfit 80.0 1.17 0.45
Note:
Results based on 500 bootstrap iterations with a sample size of 800. Conditional mean-square infit based on complete responders only, n = 1612.
Code
RIpcmPCA(df_ls)
PCA of Rasch model residuals
Eigenvalues Proportion of variance
3.21 15.7%
2.41 12.8%
1.88 10%
1.55 8.7%
1.41 7.3%
Code
source('mod_easyRasch_func.R') # Reloading function req. 
simcor1 <- RIgetResidCor(df_ls, iterations = 500, cpu = n_cores) # 500
RIresidcorr(df_ls, cutoff = simcor1$p99)
LSAS.SR_2a LSAS.SR_2b LSAS.SR_5b LSAS.SR_8a LSAS.SR_8b LSAS.SR_10a LSAS.SR_10b LSAS.SR_11a LSAS.SR_11b LSAS.SR_12a LSAS.SR_12b LSAS.SR_14a LSAS.SR_14b LSAS.SR_16a LSAS.SR_18a LSAS.SR_18b LSAS.SR_19a LSAS.SR_22a LSAS.SR_24a
LSAS.SR_2a
LSAS.SR_2b 0.52
LSAS.SR_5b -0.12 0
LSAS.SR_8a -0.06 -0.14 -0.02
LSAS.SR_8b -0.15 -0.05 0.05 0.66
LSAS.SR_10a -0.24 -0.3 -0.1 -0.12 -0.17
LSAS.SR_10b -0.3 -0.24 -0.03 -0.18 -0.11 0.68
LSAS.SR_11a -0.05 -0.1 -0.15 -0.25 -0.28 0.17 0.06
LSAS.SR_11b -0.14 0 -0.02 -0.34 -0.23 0.09 0.18 0.47
LSAS.SR_12a -0.05 -0.07 -0.2 -0.23 -0.27 0.06 -0.03 0.47 0.28
LSAS.SR_12b -0.11 0.02 -0.11 -0.29 -0.2 -0.02 0.07 0.26 0.44 0.54
LSAS.SR_14a 0.15 0.04 -0.13 0.05 -0.03 -0.26 -0.29 -0.12 -0.25 -0.16 -0.24
LSAS.SR_14b 0.04 0.13 -0.05 -0.06 0.01 -0.3 -0.2 -0.19 -0.16 -0.22 -0.11 0.57
LSAS.SR_16a 0.28 0.2 0 0 -0.04 -0.22 -0.24 -0.13 -0.21 -0.16 -0.17 0.13 0.05
LSAS.SR_18a -0.11 -0.21 -0.02 -0.08 -0.13 -0.07 -0.14 -0.06 -0.11 -0.08 -0.15 -0.12 -0.16 -0.01
LSAS.SR_18b -0.15 -0.12 0 -0.15 -0.09 -0.12 -0.06 -0.14 -0.01 -0.14 -0.06 -0.18 -0.1 -0.04 0.65
LSAS.SR_19a -0.02 -0.1 -0.03 -0.06 -0.12 -0.1 -0.17 0.04 -0.07 0.04 -0.06 -0.03 -0.11 -0.06 -0.05 -0.09
LSAS.SR_22a -0.16 -0.19 -0.11 0.01 -0.03 0.03 0.04 -0.16 -0.17 -0.08 -0.1 -0.07 -0.07 -0.16 -0.08 -0.12 -0.04
LSAS.SR_24a -0.18 -0.2 -0.08 -0.05 -0.12 0.07 0.02 -0.13 -0.13 -0.1 -0.16 -0.09 -0.1 -0.16 0.02 -0.02 -0.05 0.21
Note:
Relative cut-off value is 0.049, which is 0.099 above the average correlation (-0.05).
Correlations above the cut-off are highlighted in red text.
Code
Item 1 Item 2 Partial gamma SE Lower CI Upper CI Adjusted p-value (BH)
LSAS.SR_10a LSAS.SR_10b 0.878 0.015 0.848 0.907 0.000
LSAS.SR_10b LSAS.SR_10a 0.876 0.015 0.847 0.905 0.000
LSAS.SR_18a LSAS.SR_18b 0.856 0.017 0.823 0.889 0.000
LSAS.SR_8a LSAS.SR_8b 0.855 0.016 0.823 0.887 0.000
LSAS.SR_8b LSAS.SR_8a 0.854 0.016 0.822 0.886 0.000
LSAS.SR_18b LSAS.SR_18a 0.85 0.018 0.815 0.886 0.000
LSAS.SR_14a LSAS.SR_14b 0.808 0.020 0.770 0.847 0.000
LSAS.SR_14b LSAS.SR_14a 0.804 0.020 0.765 0.844 0.000
LSAS.SR_12a LSAS.SR_12b 0.796 0.024 0.748 0.844 0.000
LSAS.SR_12b LSAS.SR_12a 0.775 0.025 0.725 0.825 0.000
LSAS.SR_2b LSAS.SR_2a 0.774 0.024 0.728 0.821 0.000
LSAS.SR_2a LSAS.SR_2b 0.767 0.024 0.720 0.814 0.000
LSAS.SR_11a LSAS.SR_11b 0.744 0.028 0.688 0.799 0.000
LSAS.SR_11a LSAS.SR_12a 0.741 0.028 0.686 0.796 0.000
LSAS.SR_11b LSAS.SR_11a 0.738 0.029 0.681 0.795 0.000
LSAS.SR_12a LSAS.SR_11a 0.718 0.030 0.660 0.776 0.000
LSAS.SR_11b LSAS.SR_12b 0.682 0.031 0.621 0.743 0.000
LSAS.SR_12b LSAS.SR_11b 0.65 0.035 0.582 0.718 0.000
LSAS.SR_2a LSAS.SR_16a 0.5 0.039 0.425 0.576 0.000
LSAS.SR_11b LSAS.SR_12a 0.488 0.039 0.410 0.565 0.000
LSAS.SR_16a LSAS.SR_2a 0.482 0.040 0.405 0.560 0.000
LSAS.SR_12a LSAS.SR_11b 0.473 0.041 0.393 0.553 0.000
LSAS.SR_11a LSAS.SR_12b 0.469 0.043 0.385 0.552 0.000
LSAS.SR_2b LSAS.SR_16a 0.428 0.042 0.346 0.509 0.000
LSAS.SR_12b LSAS.SR_11a 0.424 0.044 0.337 0.511 0.000
LSAS.SR_16a LSAS.SR_2b 0.403 0.043 0.320 0.486 0.000
LSAS.SR_11b LSAS.SR_10b 0.376 0.041 0.297 0.456 0.000
LSAS.SR_22a LSAS.SR_24a 0.369 0.036 0.298 0.439 0.000
LSAS.SR_24a LSAS.SR_22a 0.356 0.036 0.285 0.427 0.000
LSAS.SR_11a LSAS.SR_10a 0.352 0.043 0.267 0.436 0.000
LSAS.SR_10b LSAS.SR_11b 0.331 0.041 0.250 0.411 0.000
LSAS.SR_10a LSAS.SR_11a 0.297 0.044 0.211 0.383 0.000
LSAS.SR_2a LSAS.SR_14a 0.291 0.039 0.214 0.368 0.000
LSAS.SR_14a LSAS.SR_2a 0.288 0.040 0.210 0.367 0.000
LSAS.SR_14a LSAS.SR_16a 0.274 0.044 0.188 0.360 0.000
LSAS.SR_2b LSAS.SR_14b 0.269 0.039 0.193 0.345 0.000
LSAS.SR_14b LSAS.SR_2b 0.258 0.039 0.181 0.335 0.000
LSAS.SR_16a LSAS.SR_14a 0.255 0.045 0.167 0.343 0.000
LSAS.SR_11b LSAS.SR_10a 0.229 0.044 0.143 0.315 0.000
LSAS.SR_11a LSAS.SR_19a 0.215 0.043 0.131 0.298 0.000
LSAS.SR_12a LSAS.SR_19a 0.196 0.042 0.113 0.278 0.001
LSAS.SR_10a LSAS.SR_24a 0.195 0.039 0.118 0.271 0.000
LSAS.SR_10a LSAS.SR_11b 0.189 0.044 0.103 0.274 0.006
LSAS.SR_12b LSAS.SR_10b 0.189 0.043 0.105 0.273 0.003
LSAS.SR_24a LSAS.SR_10a 0.188 0.039 0.111 0.265 0.001
LSAS.SR_11a LSAS.SR_10b 0.187 0.044 0.101 0.274 0.007
LSAS.SR_12a LSAS.SR_10a 0.18 0.043 0.097 0.264 0.008
LSAS.SR_10b LSAS.SR_12b 0.165 0.042 0.082 0.248 0.031
LSAS.SR_14a LSAS.SR_8a 0.152 0.040 0.074 0.230 0.044
Code
RIloadLoc(df_ls)

Code
mirt(df_ls, model=1, itemtype='Rasch', verbose = FALSE) %>% 
  plot(type="trace", as.table = TRUE, 
       theta_lim = c(-6,6))

Code
# for fewer items or a more magnified figure, use:
#RIitemCats(df)
Code
# increase fig-height above as needed, if you have many items
RItargeting(df_ls)

Code

Code
iarm::score_groups(as.data.frame(df_ls)) %>% 
  as.data.frame(nm = "score_group") %>% 
  dplyr::count(score_group)
  score_group   n
1           1 804
2           2 808
Code
dif_plots <- df_ls %>% 
  add_column(dif = iarm::score_groups(.)) %>% 
  split(.$dif) %>% # split the data using the DIF variable
  map(~ RItileplot(.x %>% dplyr::select(!dif)) + labs(title = .x$dif))
dif_plots[[1]] + dif_plots[[2]]

Code
clr_tests(df_ls, model = "PCM")

Conditional Likelihood Ratio Tests:
        clr df pvalue sig 
overall 348 56 0       ***
Code 
Score group 1: 
            mean obs mean exp std.res sig
LSAS.SR_2a   1.506    1.493    0.545     
LSAS.SR_2b   1.059    1.074   -0.697     
LSAS.SR_5b   1.122    1.074    2.062  +  
LSAS.SR_8a   1.115    1.069    1.807     
LSAS.SR_8b   0.776    0.710    2.876  +  
LSAS.SR_10a  1.141    1.166   -0.916     
LSAS.SR_10b  0.888    0.893   -0.193     
LSAS.SR_11a  1.208    1.324   -4.726  -- 
LSAS.SR_11b  1.046    1.131   -3.566  -- 
LSAS.SR_12a  1.217    1.302   -3.357  -- 
LSAS.SR_12b  1.014    1.075   -2.623  -  
LSAS.SR_14a  1.286    1.271    0.641     
LSAS.SR_14b  0.776    0.758    0.784     
LSAS.SR_16a  2.219    2.179    1.707     
LSAS.SR_18a  1.509    1.548   -1.511     
LSAS.SR_18b  1.455    1.436    0.720     
LSAS.SR_19a  0.875    0.814    2.472  +  
LSAS.SR_22a  0.781    0.730    2.063  +  
LSAS.SR_24a  0.563    0.510    2.366  +  

Score group 2: 
            mean obs mean exp std.res sig
LSAS.SR_2a   2.269    2.282   -0.577     
LSAS.SR_2b   1.968    1.952    0.631     
LSAS.SR_5b   1.975    2.024   -1.862     
LSAS.SR_8a   2.014    2.059   -1.822     
LSAS.SR_8b   1.644    1.710   -2.382  -  
LSAS.SR_10a  2.295    2.270    0.995     
LSAS.SR_10b  2.033    2.029    0.181     
LSAS.SR_11a  2.306    2.191    5.019  ++ 
LSAS.SR_11b  2.128    2.043    3.405  ++ 
LSAS.SR_12a  2.320    2.235    3.586  ++ 
LSAS.SR_12b  2.078    2.017    2.361  +  
LSAS.SR_14a  2.185    2.201   -0.655     
LSAS.SR_14b  1.746    1.764   -0.655     
LSAS.SR_16a  2.738    2.778   -2.614  -  
LSAS.SR_18a  2.449    2.411    1.762     
LSAS.SR_18b  2.385    2.403   -0.803     
LSAS.SR_19a  1.797    1.857   -2.269  -  
LSAS.SR_22a  1.770    1.821   -1.822     
LSAS.SR_24a  1.504    1.557   -1.838
Code
grouping_based_on_score = score_groups(as.data.frame(df_ls))
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = grouping_based_on_score) 
          Item                     Var gamma  se pvalue padj.BH sig lower upper
1   LSAS.SR_2a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
2   LSAS.SR_2b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
3   LSAS.SR_5b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
4   LSAS.SR_8a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
5   LSAS.SR_8b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
6  LSAS.SR_10a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
7  LSAS.SR_10b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
8  LSAS.SR_11a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
9  LSAS.SR_11b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
10 LSAS.SR_12a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
11 LSAS.SR_12b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
12 LSAS.SR_14a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
13 LSAS.SR_14b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
14 LSAS.SR_16a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
15 LSAS.SR_18a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
16 LSAS.SR_18b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
17 LSAS.SR_19a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
18 LSAS.SR_22a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
19 LSAS.SR_24a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
Code
dif.sex <- dif %>% filter(Time=='PRE') %>% select(sex) %>% as.vector(.)
dif.sex <- dif.sex[[1]] #female = 1, male = 2 
RIdifTable(df_ls, dif.sex)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2a -0.618 -0.661 -0.639 0.030 0.043
LSAS.SR_2b 0.241 0.036 0.138 0.145 0.205
LSAS.SR_5b 0.102 0.048 0.075 0.038 0.054
LSAS.SR_8a 0.026 0.363 0.194 0.239 0.338
LSAS.SR_8b 0.623 0.933 0.778 0.219 0.310
LSAS.SR_10a -0.126 -0.012 -0.069 0.081 0.114
LSAS.SR_10b 0.319 0.330 0.325 0.008 0.011
LSAS.SR_11a -0.190 -0.305 -0.248 0.081 0.115
LSAS.SR_11b 0.135 -0.075 0.030 0.149 0.210
LSAS.SR_12a -0.146 -0.378 -0.262 0.164 0.232
LSAS.SR_12b 0.217 -0.111 0.053 0.231 0.327
LSAS.SR_14a -0.286 -0.135 -0.210 0.107 0.152
LSAS.SR_14b 0.564 0.782 0.673 0.154 0.218
LSAS.SR_16a -2.096 -1.674 -1.885 0.298 0.422
LSAS.SR_18a -0.743 -0.566 -0.654 0.126 0.178
LSAS.SR_18b -0.592 -0.557 -0.574 0.025 0.035
LSAS.SR_19a 0.712 0.398 0.555 0.222 0.314
LSAS.SR_22a 0.780 0.508 0.644 0.192 0.272
LSAS.SR_24a 1.079 1.073 1.076 0.004 0.006
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.sex) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2a dif.sex  0.0113 0.0496 0.8192  1.0000      -0.0858  0.1085
2   LSAS.SR_2b dif.sex  0.1203 0.0491 0.0143  0.2722       0.0240  0.2167
3   LSAS.SR_5b dif.sex -0.0142 0.0482 0.7690  1.0000      -0.1087  0.0804
4   LSAS.SR_8a dif.sex -0.1739 0.0458 0.0001  0.0028   ** -0.2637 -0.0842
5   LSAS.SR_8b dif.sex -0.1454 0.0466 0.0018  0.0341    * -0.2367 -0.0541
6  LSAS.SR_10a dif.sex -0.0804 0.0478 0.0927  1.0000      -0.1741  0.0133
7  LSAS.SR_10b dif.sex -0.0143 0.0475 0.7633  1.0000      -0.1074  0.0788
8  LSAS.SR_11a dif.sex  0.0706 0.0548 0.1971  1.0000      -0.0367  0.1780
9  LSAS.SR_11b dif.sex  0.2004 0.0512 0.0001  0.0017   **  0.1000  0.3008
10 LSAS.SR_12a dif.sex  0.1893 0.0508 0.0002  0.0037   **  0.0897  0.2889
11 LSAS.SR_12b dif.sex  0.2700 0.0491 0.0000  0.0000  ***  0.1737  0.3663
12 LSAS.SR_14a dif.sex -0.1231 0.0477 0.0098  0.1871      -0.2166 -0.0296
13 LSAS.SR_14b dif.sex -0.1122 0.0474 0.0180  0.3427      -0.2052 -0.0192
14 LSAS.SR_16a dif.sex -0.2540 0.0514 0.0000  0.0000  *** -0.3546 -0.1533
15 LSAS.SR_18a dif.sex -0.1628 0.0491 0.0009  0.0174    * -0.2590 -0.0665
16 LSAS.SR_18b dif.sex -0.0399 0.0483 0.4085  1.0000      -0.1345  0.0547
17 LSAS.SR_19a dif.sex  0.1683 0.0454 0.0002  0.0041   **  0.0792  0.2573
18 LSAS.SR_22a dif.sex  0.1913 0.0449 0.0000  0.0004  ***  0.1034  0.2792
19 LSAS.SR_24a dif.sex  0.0578 0.0472 0.2201  1.0000      -0.0346  0.1503
Code
dif.age <- dif %>% filter(Time=='PRE') %>% select(age) %>% as.vector(.)
dif.age <- dif.age[[1]]
RIdifTable(df_ls, dif.age)

Item 2 4 5 Mean location StDev MaxDiff
LSAS.SR_2a -0.539 -0.715 -0.599 -0.618 0.089 0.176
LSAS.SR_2b 0.204 0.167 0.076 0.149 0.066 0.128
LSAS.SR_5b 0.301 0.070 -0.067 0.101 0.186 0.368
LSAS.SR_8a 0.325 0.162 0.061 0.183 0.133 0.264
LSAS.SR_8b 0.909 0.749 0.577 0.745 0.166 0.332
LSAS.SR_10a -0.286 -0.124 0.175 -0.078 0.234 0.461
LSAS.SR_10b 0.026 0.362 0.526 0.305 0.255 0.500
LSAS.SR_11a -0.958 -0.178 -0.099 -0.412 0.475 0.859
LSAS.SR_11b -0.220 0.023 0.261 0.021 0.240 0.480
LSAS.SR_12a -0.484 -0.204 -0.148 -0.279 0.180 0.336
LSAS.SR_12b -0.218 0.152 0.206 0.047 0.231 0.424
LSAS.SR_14a -0.064 -0.158 -0.482 -0.235 0.219 0.418
LSAS.SR_14b 0.782 0.730 0.356 0.623 0.232 0.426
LSAS.SR_16a -1.203 -1.901 -2.220 -1.775 0.520 1.017
LSAS.SR_18a -0.268 -0.776 -0.746 -0.596 0.285 0.508
LSAS.SR_18b -0.309 -0.644 -0.610 -0.521 0.184 0.334
LSAS.SR_19a 0.548 0.518 0.702 0.589 0.099 0.184
LSAS.SR_22a 0.487 0.676 0.911 0.692 0.212 0.424
LSAS.SR_24a 0.967 1.089 1.122 1.059 0.082 0.155
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.age) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2a dif.age  0.0179 0.0304 0.5556  1.0000      -0.0417  0.0775
2   LSAS.SR_2b dif.age  0.0362 0.0310 0.2433  1.0000      -0.0246  0.0969
3   LSAS.SR_5b dif.age  0.0316 0.0297 0.2862  1.0000      -0.0265  0.0898
4   LSAS.SR_8a dif.age  0.0643 0.0296 0.0296  0.5621       0.0064  0.1223
5   LSAS.SR_8b dif.age  0.0862 0.0290 0.0029  0.0553    .  0.0294  0.1430
6  LSAS.SR_10a dif.age -0.1256 0.0283 0.0000  0.0002  *** -0.1811 -0.0700
7  LSAS.SR_10b dif.age -0.1276 0.0288 0.0000  0.0002  *** -0.1841 -0.0712
8  LSAS.SR_11a dif.age -0.1108 0.0336 0.0010  0.0187    * -0.1767 -0.0449
9  LSAS.SR_11b dif.age -0.0726 0.0323 0.0247  0.4694      -0.1359 -0.0092
10 LSAS.SR_12a dif.age -0.0821 0.0323 0.0111  0.2105      -0.1455 -0.0188
11 LSAS.SR_12b dif.age -0.0674 0.0322 0.0360  0.6834      -0.1305 -0.0044
12 LSAS.SR_14a dif.age  0.0742 0.0296 0.0121  0.2300       0.0162  0.1321
13 LSAS.SR_14b dif.age  0.1353 0.0286 0.0000  0.0000  ***  0.0792  0.1914
14 LSAS.SR_16a dif.age  0.0966 0.0331 0.0035  0.0670    .  0.0317  0.1615
15 LSAS.SR_18a dif.age  0.1266 0.0309 0.0000  0.0008  ***  0.0661  0.1871
16 LSAS.SR_18b dif.age  0.0324 0.0297 0.2753  1.0000      -0.0258  0.0906
17 LSAS.SR_19a dif.age -0.0334 0.0285 0.2407  1.0000      -0.0891  0.0224
18 LSAS.SR_22a dif.age -0.0547 0.0280 0.0511  0.9718      -0.1097  0.0003
19 LSAS.SR_24a dif.age -0.0358 0.0287 0.2117  1.0000      -0.0920  0.0204
Code
dif.edu <- dif %>% filter(Time=='PRE') %>% select(education) %>% as.vector(.)
dif.edu <- dif.edu[[1]]
RIdifTable(df_ls, dif.edu)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2a -0.741 -0.556 -0.648 0.131 0.185
LSAS.SR_2b 0.073 0.282 0.178 0.148 0.209
LSAS.SR_5b 0.217 -0.095 0.061 0.220 0.312
LSAS.SR_8a 0.241 0.077 0.159 0.116 0.165
LSAS.SR_8b 0.840 0.590 0.715 0.177 0.250
LSAS.SR_10a -0.050 -0.088 -0.069 0.027 0.038
LSAS.SR_10b 0.294 0.391 0.343 0.069 0.097
LSAS.SR_11a -0.350 -0.116 -0.233 0.166 0.234
LSAS.SR_11b -0.031 0.134 0.051 0.116 0.165
LSAS.SR_12a -0.369 -0.111 -0.240 0.183 0.259
LSAS.SR_12b -0.051 0.263 0.106 0.222 0.315
LSAS.SR_14a -0.215 -0.238 -0.226 0.016 0.023
LSAS.SR_14b 0.661 0.628 0.644 0.024 0.033
LSAS.SR_16a -1.892 -1.908 -1.900 0.011 0.016
LSAS.SR_18a -0.506 -0.852 -0.679 0.245 0.346
LSAS.SR_18b -0.414 -0.768 -0.591 0.250 0.354
LSAS.SR_19a 0.547 0.621 0.584 0.052 0.073
LSAS.SR_22a 0.664 0.689 0.677 0.018 0.025
LSAS.SR_24a 1.081 1.056 1.068 0.018 0.025
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.edu) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2a dif.edu -0.0516 0.0447 0.2475  1.0000      -0.1392  0.0359
2   LSAS.SR_2b dif.edu -0.1233 0.0443 0.0054  0.1019      -0.2100 -0.0365
3   LSAS.SR_5b dif.edu  0.1442 0.0430 0.0008  0.0153    *  0.0599  0.2286
4   LSAS.SR_8a dif.edu  0.0737 0.0425 0.0825  1.0000      -0.0095  0.1570
5   LSAS.SR_8b dif.edu  0.0771 0.0428 0.0716  1.0000      -0.0068  0.1609
6  LSAS.SR_10a dif.edu  0.0116 0.0437 0.7897  1.0000      -0.0739  0.0972
7  LSAS.SR_10b dif.edu -0.0457 0.0437 0.2960  1.0000      -0.1313  0.0400
8  LSAS.SR_11a dif.edu -0.0075 0.0502 0.8805  1.0000      -0.1059  0.0908
9  LSAS.SR_11b dif.edu -0.0313 0.0491 0.5231  1.0000      -0.1275  0.0649
10 LSAS.SR_12a dif.edu -0.0853 0.0473 0.0710  1.0000      -0.1780  0.0073
11 LSAS.SR_12b dif.edu -0.1374 0.0466 0.0032  0.0606    . -0.2288 -0.0461
12 LSAS.SR_14a dif.edu -0.0599 0.0439 0.1723  1.0000      -0.1460  0.0261
13 LSAS.SR_14b dif.edu -0.0139 0.0443 0.7541  1.0000      -0.1008  0.0730
14 LSAS.SR_16a dif.edu -0.0443 0.0499 0.3747  1.0000      -0.1421  0.0535
15 LSAS.SR_18a dif.edu  0.2215 0.0438 0.0000  0.0000  ***  0.1357  0.3074
16 LSAS.SR_18b dif.edu  0.1969 0.0429 0.0000  0.0001  ***  0.1129  0.2810
17 LSAS.SR_19a dif.edu -0.0690 0.0426 0.1049  1.0000      -0.1525  0.0144
18 LSAS.SR_22a dif.edu -0.0431 0.0421 0.3062  1.0000      -0.1255  0.0394
19 LSAS.SR_24a dif.edu -0.0195 0.0441 0.6576  1.0000      -0.1059  0.0668
Code
dif.yr <- dif %>% filter(Time=='PRE') %>% select(TreatmentAccessStart) %>% as.vector(.)
dif.yr <- dif.yr[[1]]
RIdifTable(df_ls, dif.yr)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2a -0.804 -0.447 -0.625 0.252 0.357
LSAS.SR_2b 0.019 0.307 0.163 0.204 0.288
LSAS.SR_5b 0.079 0.085 0.082 0.004 0.006
LSAS.SR_8a 0.179 0.174 0.177 0.003 0.004
LSAS.SR_8b 0.809 0.679 0.744 0.092 0.130
LSAS.SR_10a -0.002 -0.160 -0.081 0.112 0.158
LSAS.SR_10b 0.436 0.196 0.316 0.170 0.241
LSAS.SR_11a -0.223 -0.264 -0.243 0.029 0.041
LSAS.SR_11b 0.107 -0.027 0.040 0.095 0.134
LSAS.SR_12a -0.239 -0.255 -0.247 0.011 0.016
LSAS.SR_12b 0.152 -0.016 0.068 0.119 0.168
LSAS.SR_14a -0.315 -0.132 -0.224 0.129 0.183
LSAS.SR_14b 0.642 0.652 0.647 0.007 0.010
LSAS.SR_16a -2.200 -1.569 -1.885 0.446 0.631
LSAS.SR_18a -0.607 -0.753 -0.680 0.103 0.146
LSAS.SR_18b -0.490 -0.670 -0.580 0.127 0.179
LSAS.SR_19a 0.603 0.559 0.581 0.032 0.045
LSAS.SR_22a 0.620 0.725 0.673 0.074 0.105
LSAS.SR_24a 1.235 0.916 1.075 0.225 0.318
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.yr) 
          Item    Var   gamma     se pvalue padj.BH sig   lower   upper
1   LSAS.SR_2a dif.yr -0.1042 0.0310 0.0008  0.0149   * -0.1650 -0.0434
2   LSAS.SR_2b dif.yr -0.0951 0.0318 0.0028  0.0532   . -0.1575 -0.0328
3   LSAS.SR_5b dif.yr -0.0180 0.0309 0.5597  1.0000     -0.0787  0.0426
4   LSAS.SR_8a dif.yr  0.0125 0.0304 0.6820  1.0000     -0.0472  0.0722
5   LSAS.SR_8b dif.yr  0.0154 0.0302 0.6105  1.0000     -0.0438  0.0746
6  LSAS.SR_10a dif.yr  0.0877 0.0315 0.0053  0.1016      0.0260  0.1494
7  LSAS.SR_10b dif.yr  0.0877 0.0308 0.0044  0.0837   .  0.0273  0.1481
8  LSAS.SR_11a dif.yr -0.0463 0.0366 0.2053  1.0000     -0.1180  0.0254
9  LSAS.SR_11b dif.yr -0.0017 0.0341 0.9593  1.0000     -0.0685  0.0650
10 LSAS.SR_12a dif.yr -0.0905 0.0351 0.0100  0.1895     -0.1594 -0.0217
11 LSAS.SR_12b dif.yr  0.0049 0.0344 0.8867  1.0000     -0.0625  0.0723
12 LSAS.SR_14a dif.yr -0.0598 0.0321 0.0624  1.0000     -0.1227  0.0031
13 LSAS.SR_14b dif.yr -0.0209 0.0322 0.5170  1.0000     -0.0840  0.0422
14 LSAS.SR_16a dif.yr -0.0690 0.0353 0.0504  0.9567     -0.1381  0.0001
15 LSAS.SR_18a dif.yr  0.0367 0.0323 0.2549  1.0000     -0.0265  0.1000
16 LSAS.SR_18b dif.yr  0.0979 0.0310 0.0016  0.0306   *  0.0370  0.1587
17 LSAS.SR_19a dif.yr  0.0070 0.0296 0.8143  1.0000     -0.0511  0.0650
18 LSAS.SR_22a dif.yr -0.0185 0.0306 0.5446  1.0000     -0.0786  0.0415
19 LSAS.SR_24a dif.yr  0.0820 0.0307 0.0076  0.1452      0.0217  0.1422

10.1 Analysis part 1 decision

We see here that the biggest problem is the residual correlations coming from the posed situations having an fear component (a) and an avoidance component (b) and they are highly correlated. Yet from the mokken they do seem to load on the same dimension (party confirmed with the EFA) - and while the PCA and the component plot in the rasch analyses is more nauanced it is not decisive. The targeting across a/b is mostly equivalent.

We inspect score distributions overall as well

Code
RItileplot(df_ls)

  • Of 2 a/b a had a more even distribution
    • residual cor = 0.52
    • b overfit = 5%

Marginal differences here and small overfit. 2b had also smaller residual correlations to other items (including a items below which will be kept) Keeping 2b

  • Of 8 a/b a had a more even distribution
    • residual cor = 0.66
    • b underfit = 82%
  • Of 10 a/b a had a more even distribution
    • residual cor = 0.68
    • b overfit = 14%
  • Of 11 a/b b had a more even distribution
    • residual cor = 0.28
    • a overfit = 100%
  • Of 12 a/b b had a more even distirbution
    • residual cor = 0.54
    • a overfit = 100%
    • b overfit = 99.8% However the residual correlation between 12 b and 11b was high .44 . And correlation between 11b and 12a was lower (.28) keeping 12a for now.
  • Of 14 a/b a had a more even distribution
    • residual cor = 0.57
    • a and b no misfit
  • Of 18 a/b b had a more even distirbution
    • residual cor = 0.65
    • a overfit = 14%

Thus in the first round we remove 2a, 8b, 10b, 11a, 12a, 14b, 18a.

11 Rasch analysis 2

Code
df_ls <- df_ls %>% select(!c(LSAS.SR_2a,LSAS.SR_8b,LSAS.SR_10b,LSAS.SR_11a,LSAS.SR_12b,LSAS.SR_14b,LSAS.SR_18a))
RIlistItemsMargin(df_ls, fontsize = 12)
itemnr item
LSAS.SR_2b small group avoid
LSAS.SR_5b talking authority avoid
LSAS.SR_8a work obs anxiety
LSAS.SR_10a call new anxiety
LSAS.SR_11b talk new avoid
LSAS.SR_12a stranger anxiety
LSAS.SR_14a enter room anxiety
LSAS.SR_16a speaking up anxiety
LSAS.SR_18b disagreement avoid
LSAS.SR_19a eye contact anxiety
LSAS.SR_22a returning goods anxiety
LSAS.SR_24a resisting sales anxiety
Code
RIitemfit(df_ls, cutoff = "Smith98")
Item InfitMSQ Location 1 ± 2 / √n
LSAS.SR_2b 1 0.16 [0.95, 1.05]
LSAS.SR_5b 1.053 0.09 [0.95, 1.05]
LSAS.SR_8a 1.125 0.18 [0.95, 1.05]
LSAS.SR_10a 0.948 -0.06 [0.95, 1.05]
LSAS.SR_11b 0.784 0.06 [0.95, 1.05]
LSAS.SR_12a 0.793 -0.22 [0.95, 1.05]
LSAS.SR_14a 1.032 -0.20 [0.95, 1.05]
LSAS.SR_16a 1.186 -1.74 [0.95, 1.05]
LSAS.SR_18b 1.047 -0.53 [0.95, 1.05]
LSAS.SR_19a 1.041 0.57 [0.95, 1.05]
LSAS.SR_22a 1.046 0.65 [0.95, 1.05]
LSAS.SR_24a 1.046 1.04 [0.95, 1.05]
Note:
MSQ values based on conditional estimation (n = 1612 complete cases).
Code
# Getting error for estimating the simfit for LSAS. 
# Getting same error for week 2 and week 1 
#df_week02 <- df %>% filter(Time=='WEEK02') %>% select(!Time) 
simfit1 <- RIgetfit(df_ls, iterations = 300, cpu = n_cores)  # 

RIitemfit(df_ls, simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 1 [0.924, 1.08] 1.004 [0.905, 1.105] no misfit no misfit 0.16
LSAS.SR_5b 1.053 [0.925, 1.057] 1.057 [0.922, 1.068] no misfit no misfit 0.09
LSAS.SR_8a 1.125 [0.913, 1.087] 1.149 [0.916, 1.089] 0.038 0.06 0.18
LSAS.SR_10a 0.948 [0.928, 1.074] 0.953 [0.925, 1.087] no misfit no misfit -0.06
LSAS.SR_11b 0.784 [0.921, 1.078] 0.778 [0.876, 1.154] 0.137 0.098 0.06
LSAS.SR_12a 0.793 [0.941, 1.086] 0.782 [0.928, 1.109] 0.148 0.146 -0.22
LSAS.SR_14a 1.032 [0.926, 1.085] 1.023 [0.914, 1.091] no misfit no misfit -0.20
LSAS.SR_16a 1.186 [0.918, 1.099] 1.156 [0.917, 1.09] 0.087 0.066 -1.74
LSAS.SR_18b 1.047 [0.911, 1.092] 1.056 [0.9, 1.113] no misfit no misfit -0.53
LSAS.SR_19a 1.041 [0.934, 1.091] 1.038 [0.925, 1.089] no misfit no misfit 0.57
LSAS.SR_22a 1.046 [0.935, 1.078] 1.033 [0.921, 1.089] no misfit no misfit 0.65
LSAS.SR_24a 1.046 [0.92, 1.066] 1.013 [0.914, 1.082] no misfit no misfit 1.04
Note:
MSQ values based on conditional calculations (n = 1612 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RIgetfitPlot(simfit1, df_ls)

Code
#skipped right now 
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 1:4, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[1:4])

### also suggested:
# library(RASCHplot) # install first with `devtools::install_github("ERRTG/RASCHplot")`
# CICCplot(PCM(df),
#          which.item = c(1:4),
#          lower.groups = c(0,7,14,21,28,35),
#          grid.items = TRUE)
Code
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 5:7, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[5:7])

This is severely limited due to the large number of items

Code
Item Observed value Model expected value Absolute difference Adjusted p-value (BH) Statistical significance level Location Relative location
LSAS.SR_2b 0.53 0.52 0.01 0.680 0.16 -0.14
LSAS.SR_5b 0.50 0.52 0.02 0.381 0.09 -0.21
LSAS.SR_8a 0.46 0.52 0.06 0.006 ** 0.18 -0.12
LSAS.SR_10a 0.57 0.53 0.04 0.146 -0.06 -0.36
LSAS.SR_11b 0.65 0.52 0.13 0.000 *** 0.06 -0.24
LSAS.SR_12a 0.65 0.52 0.13 0.000 *** -0.22 -0.51
LSAS.SR_14a 0.50 0.52 0.02 0.513 -0.20 -0.50
LSAS.SR_16a 0.44 0.50 0.06 0.015 * -1.74 -2.04
LSAS.SR_18b 0.49 0.52 0.03 0.270 -0.53 -0.83
LSAS.SR_19a 0.50 0.53 0.03 0.298 0.57 0.27
LSAS.SR_22a 0.51 0.53 0.02 0.381 0.65 0.35
LSAS.SR_24a 0.52 0.53 0.01 0.674 1.04 0.74
Code
RIbootRestscore(df_ls,cpu=n_cores,iterations = 500,samplesize=800) # samplesize=600
Item Item-restscore result % of iterations Conditional MSQ infit Relative average item location
LSAS.SR_10a no misfit 85.2 0.95 -0.36
LSAS.SR_10a overfit 14.8 0.95 -0.36
LSAS.SR_11b overfit 100.0 0.78 -0.24
LSAS.SR_12a overfit 100.0 0.79 -0.51
LSAS.SR_14a no misfit 98.6 1.03 -0.50
LSAS.SR_16a no misfit 66.8 1.19 -2.04
LSAS.SR_16a underfit 33.2 1.19 -2.04
LSAS.SR_18b no misfit 93.8 1.05 -0.83
LSAS.SR_18b underfit 6.2 1.05 -0.83
LSAS.SR_19a no misfit 97.2 1.04 0.27
LSAS.SR_22a no misfit 98.0 1.05 0.35
LSAS.SR_24a no misfit 99.4 1.05 0.74
LSAS.SR_2b no misfit 99.2 1.00 -0.14
LSAS.SR_5b no misfit 97.6 1.05 -0.21
LSAS.SR_8a no misfit 61.2 1.13 -0.12
LSAS.SR_8a underfit 38.8 1.13 -0.12
Note:
Results based on 500 bootstrap iterations with a sample size of 800. Conditional mean-square infit based on complete responders only, n = 1612.
Code
RIpcmPCA(df_ls)
PCA of Rasch model residuals
Eigenvalues Proportion of variance
1.90 16%
1.70 13.5%
1.30 10.9%
1.13 9.9%
1.07 9.2%
Code
source('mod_easyRasch_func.R') # Reloading function req. 
simcor1 <- RIgetResidCor(df_ls, iterations = 500, cpu = n_cores) # 500
RIresidcorr(df_ls, cutoff = simcor1$p99)
LSAS.SR_2b LSAS.SR_5b LSAS.SR_8a LSAS.SR_10a LSAS.SR_11b LSAS.SR_12a LSAS.SR_14a LSAS.SR_16a LSAS.SR_18b LSAS.SR_19a LSAS.SR_22a LSAS.SR_24a
LSAS.SR_2b
LSAS.SR_5b 0
LSAS.SR_8a -0.12 -0.04
LSAS.SR_10a -0.27 -0.11 -0.11
LSAS.SR_11b 0.05 -0.01 -0.3 0.13
LSAS.SR_12a -0.03 -0.2 -0.2 0.1 0.33
LSAS.SR_14a 0.06 -0.15 0.05 -0.24 -0.2 -0.12
LSAS.SR_16a 0.19 -0.03 -0.02 -0.23 -0.19 -0.15 0.12
LSAS.SR_18b -0.09 -0.01 -0.15 -0.09 0.03 -0.1 -0.17 -0.04
LSAS.SR_19a -0.11 -0.08 -0.09 -0.13 -0.07 0.03 -0.05 -0.1 -0.11
LSAS.SR_22a -0.21 -0.17 -0.02 0.01 -0.17 -0.09 -0.09 -0.2 -0.15 -0.11
LSAS.SR_24a -0.23 -0.14 -0.09 0.05 -0.14 -0.12 -0.12 -0.2 -0.05 -0.13 0.15
Note:
Relative cut-off value is 0.017, which is 0.096 above the average correlation (-0.08).
Correlations above the cut-off are highlighted in red text.
Code
Item 1 Item 2 Partial gamma SE Lower CI Upper CI Adjusted p-value (BH)
LSAS.SR_12a LSAS.SR_11b 0.562 0.034 0.494 0.629 0.000
LSAS.SR_11b LSAS.SR_12a 0.546 0.035 0.477 0.615 0.000
LSAS.SR_2b LSAS.SR_16a 0.441 0.040 0.363 0.520 0.000
LSAS.SR_16a LSAS.SR_2b 0.415 0.040 0.336 0.494 0.000
LSAS.SR_22a LSAS.SR_24a 0.342 0.035 0.273 0.412 0.000
LSAS.SR_24a LSAS.SR_22a 0.338 0.036 0.267 0.409 0.000
LSAS.SR_11b LSAS.SR_10a 0.333 0.038 0.257 0.408 0.000
LSAS.SR_14a LSAS.SR_16a 0.291 0.042 0.208 0.375 0.000
LSAS.SR_10a LSAS.SR_11b 0.282 0.040 0.204 0.360 0.000
LSAS.SR_16a LSAS.SR_14a 0.28 0.042 0.198 0.363 0.000
LSAS.SR_12a LSAS.SR_10a 0.27 0.040 0.193 0.348 0.000
LSAS.SR_10a LSAS.SR_12a 0.231 0.040 0.153 0.310 0.000
LSAS.SR_14a LSAS.SR_8a 0.21 0.038 0.136 0.284 0.000
LSAS.SR_2b LSAS.SR_14a 0.209 0.040 0.131 0.287 0.000
LSAS.SR_11b LSAS.SR_2b 0.209 0.043 0.124 0.294 0.000
LSAS.SR_10a LSAS.SR_24a 0.206 0.038 0.132 0.281 0.000
LSAS.SR_12a LSAS.SR_19a 0.202 0.041 0.123 0.282 0.000
LSAS.SR_14a LSAS.SR_2b 0.196 0.040 0.117 0.274 0.000
LSAS.SR_11b LSAS.SR_18b 0.189 0.042 0.107 0.272 0.001
LSAS.SR_8a LSAS.SR_14a 0.187 0.038 0.112 0.261 0.000
LSAS.SR_24a LSAS.SR_10a 0.185 0.038 0.111 0.260 0.000
LSAS.SR_10a LSAS.SR_22a 0.172 0.038 0.097 0.248 0.001
LSAS.SR_22a LSAS.SR_10a 0.139 0.038 0.064 0.215 0.038
Code
RIloadLoc(df_ls)

Code
mirt(df_ls, model=1, itemtype='Rasch', verbose = FALSE) %>% 
  plot(type="trace", as.table = TRUE, 
       theta_lim = c(-6,6))

Code
# for fewer items or a more magnified figure, use:
#RIitemCats(df)
Code
# increase fig-height above as needed, if you have many items
RItargeting(df_ls)

Code

Code
iarm::score_groups(as.data.frame(df_ls)) %>% 
  as.data.frame(nm = "score_group") %>% 
  dplyr::count(score_group)
  score_group   n
1           1 809
2           2 803
Code
dif_plots <- df_ls %>% 
  add_column(dif = iarm::score_groups(.)) %>% 
  split(.$dif) %>% # split the data using the DIF variable
  map(~ RItileplot(.x %>% dplyr::select(!dif)) + labs(title = .x$dif))
dif_plots[[1]] + dif_plots[[2]]

Code
clr_tests(df_ls, model = "PCM")

Conditional Likelihood Ratio Tests:
        clr df pvalue  sig 
overall 131 35 5.3e-13  ***
Code 
Score group 1: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.0705   1.0798  -0.4043    
LSAS.SR_5b   1.1040   1.0785   1.0756    
LSAS.SR_8a   1.1139   1.0738   1.5721    
LSAS.SR_10a  1.1584   1.1702  -0.4276    
LSAS.SR_11b  1.0631   1.1364  -3.0565 -- 
LSAS.SR_12a  1.2302   1.3074  -3.0236 -- 
LSAS.SR_14a  1.2748   1.2759  -0.0466    
LSAS.SR_16a  2.2092   2.1854   1.0002    
LSAS.SR_18b  1.4790   1.4410   1.4441    
LSAS.SR_19a  0.8329   0.8188   0.5696    
LSAS.SR_22a  0.7537   0.7338   0.8049    
LSAS.SR_24a  0.5248   0.5134   0.5009    

Score group 2: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.957    1.948    0.369     
LSAS.SR_5b   1.995    2.021   -0.984     
LSAS.SR_8a   2.016    2.057   -1.601     
LSAS.SR_10a  2.282    2.270    0.470     
LSAS.SR_11b  2.114    2.040    2.951  +  
LSAS.SR_12a  2.311    2.233    3.267  ++ 
LSAS.SR_14a  2.199    2.198    0.049     
LSAS.SR_16a  2.751    2.775   -1.542     
LSAS.SR_18b  2.363    2.402   -1.629     
LSAS.SR_19a  1.841    1.855   -0.529     
LSAS.SR_22a  1.799    1.820   -0.717     
LSAS.SR_24a  1.543    1.554   -0.394
Code
grouping_based_on_score = score_groups(as.data.frame(df_ls))
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = grouping_based_on_score) 
          Item                     Var gamma  se pvalue padj.BH sig lower upper
1   LSAS.SR_2b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
2   LSAS.SR_5b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
3   LSAS.SR_8a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
4  LSAS.SR_10a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
5  LSAS.SR_11b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
6  LSAS.SR_12a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
7  LSAS.SR_14a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
8  LSAS.SR_16a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
9  LSAS.SR_18b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
10 LSAS.SR_19a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
11 LSAS.SR_22a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
12 LSAS.SR_24a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
Code
dif.sex <- dif %>% filter(Time=='PRE') %>% select(sex) %>% as.vector(.)
dif.sex <- dif.sex[[1]] #female = 1, male = 2 
RIdifTable(df_ls, dif.sex)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.240 0.063 0.151 0.125 0.176
LSAS.SR_5b 0.107 0.073 0.090 0.024 0.034
LSAS.SR_8a 0.038 0.377 0.207 0.240 0.340
LSAS.SR_10a -0.107 0.017 -0.045 0.088 0.124
LSAS.SR_11b 0.140 -0.042 0.049 0.129 0.182
LSAS.SR_12a -0.125 -0.330 -0.228 0.145 0.205
LSAS.SR_14a -0.259 -0.098 -0.179 0.114 0.161
LSAS.SR_16a -1.964 -1.541 -1.753 0.299 0.423
LSAS.SR_18b -0.550 -0.502 -0.526 0.034 0.048
LSAS.SR_19a 0.690 0.410 0.550 0.198 0.280
LSAS.SR_22a 0.754 0.515 0.635 0.169 0.239
LSAS.SR_24a 1.039 1.058 1.048 0.014 0.020
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.sex) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.sex  0.0938 0.0478 0.0496  0.5950       0.0002  0.1874
2   LSAS.SR_5b dif.sex -0.0196 0.0471 0.6765  1.0000      -0.1119  0.0726
3   LSAS.SR_8a dif.sex -0.2040 0.0445 0.0000  0.0001  *** -0.2913 -0.1167
4  LSAS.SR_10a dif.sex -0.0899 0.0469 0.0552  0.6628      -0.1819  0.0020
5  LSAS.SR_11b dif.sex  0.1756 0.0496 0.0004  0.0049   **  0.0783  0.2728
6  LSAS.SR_12a dif.sex  0.1448 0.0501 0.0039  0.0463    *  0.0466  0.2429
7  LSAS.SR_14a dif.sex -0.1515 0.0465 0.0011  0.0134    * -0.2425 -0.0604
8  LSAS.SR_16a dif.sex -0.2815 0.0506 0.0000  0.0000  *** -0.3806 -0.1823
9  LSAS.SR_18b dif.sex -0.0506 0.0471 0.2823  1.0000      -0.1428  0.0416
10 LSAS.SR_19a dif.sex  0.1658 0.0450 0.0002  0.0027   **  0.0777  0.2539
11 LSAS.SR_22a dif.sex  0.1889 0.0446 0.0000  0.0003  ***  0.1015  0.2763
12 LSAS.SR_24a dif.sex  0.0490 0.0469 0.2965  1.0000      -0.0430  0.1409
Code
dif.age <- dif %>% filter(Time=='PRE') %>% select(age) %>% as.vector(.)
dif.age <- dif.age[[1]]
RIdifTable(df_ls, dif.age)

Item 4 6 7 8 9 Mean location StDev MaxDiff
LSAS.SR_2b -0.049 0.204 0.193 0.179 0.088 0.123 0.107 0.253
LSAS.SR_5b 0.687 0.336 -0.319 0.087 -0.050 0.148 0.383 1.006
LSAS.SR_8a 0.306 0.371 0.167 0.179 0.073 0.219 0.119 0.298
LSAS.SR_10a -0.334 -0.273 -0.243 -0.095 0.181 -0.153 0.206 0.515
LSAS.SR_11b -0.400 -0.219 -0.096 0.045 0.264 -0.081 0.253 0.663
LSAS.SR_12a -0.639 -0.482 -0.368 -0.167 -0.124 -0.356 0.215 0.514
LSAS.SR_14a -0.156 -0.177 0.108 -0.128 -0.439 -0.158 0.194 0.547
LSAS.SR_16a -1.315 -1.620 -0.786 -1.747 -2.076 -1.509 0.488 1.290
LSAS.SR_18b -0.586 -0.257 -0.327 -0.588 -0.562 -0.464 0.159 0.331
LSAS.SR_19a 1.211 0.657 0.352 0.515 0.682 0.684 0.323 0.858
LSAS.SR_22a 0.558 0.489 0.377 0.664 0.882 0.594 0.192 0.505
LSAS.SR_24a 0.715 0.971 0.943 1.057 1.082 0.953 0.145 0.366
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.age) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.age  0.0420 0.0295 0.1550  1.0000      -0.0159  0.0999
2   LSAS.SR_5b dif.age  0.0678 0.0289 0.0190  0.2280       0.0111  0.1244
3   LSAS.SR_8a dif.age  0.0609 0.0274 0.0260  0.3115       0.0073  0.1145
4  LSAS.SR_10a dif.age -0.1296 0.0274 0.0000  0.0000  *** -0.1832 -0.0759
5  LSAS.SR_11b dif.age -0.0842 0.0310 0.0065  0.0782    . -0.1449 -0.0236
6  LSAS.SR_12a dif.age -0.0637 0.0317 0.0440  0.5279      -0.1258 -0.0017
7  LSAS.SR_14a dif.age  0.0706 0.0281 0.0119  0.1424       0.0156  0.1256
8  LSAS.SR_16a dif.age  0.0877 0.0321 0.0063  0.0753    .  0.0248  0.1507
9  LSAS.SR_18b dif.age  0.0342 0.0286 0.2311  1.0000      -0.0218  0.0902
10 LSAS.SR_19a dif.age -0.0281 0.0279 0.3130  1.0000      -0.0828  0.0265
11 LSAS.SR_22a dif.age -0.0469 0.0280 0.0942  1.0000      -0.1018  0.0080
12 LSAS.SR_24a dif.age -0.0131 0.0281 0.6415  1.0000      -0.0681  0.0420
Code
dif.edu <- dif %>% filter(Time=='PRE') %>% select(education) %>% as.vector(.)
dif.edu <- dif.edu[[1]]
RIdifTable(df_ls, dif.edu)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.079 0.292 0.185 0.151 0.213
LSAS.SR_5b 0.217 -0.066 0.076 0.200 0.283
LSAS.SR_8a 0.243 0.098 0.170 0.102 0.145
LSAS.SR_10a -0.036 -0.059 -0.048 0.016 0.023
LSAS.SR_11b -0.021 0.151 0.065 0.122 0.172
LSAS.SR_12a -0.344 -0.076 -0.210 0.189 0.267
LSAS.SR_14a -0.196 -0.198 -0.197 0.002 0.003
LSAS.SR_16a -1.791 -1.747 -1.769 0.031 0.044
LSAS.SR_18b -0.388 -0.697 -0.543 0.219 0.309
LSAS.SR_19a 0.537 0.610 0.574 0.052 0.074
LSAS.SR_22a 0.650 0.674 0.662 0.017 0.024
LSAS.SR_24a 1.050 1.018 1.034 0.022 0.032
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.edu) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.edu -0.1246 0.0430 0.0038  0.0451    * -0.2090 -0.0403
2   LSAS.SR_5b dif.edu  0.1795 0.0420 0.0000  0.0002  ***  0.0971  0.2618
3   LSAS.SR_8a dif.edu  0.0760 0.0415 0.0669  0.8023      -0.0053  0.1572
4  LSAS.SR_10a dif.edu -0.0010 0.0425 0.9806  1.0000      -0.0844  0.0824
5  LSAS.SR_11b dif.edu -0.0513 0.0465 0.2702  1.0000      -0.1425  0.0399
6  LSAS.SR_12a dif.edu -0.0886 0.0455 0.0517  0.6208      -0.1778  0.0007
7  LSAS.SR_14a dif.edu -0.0593 0.0424 0.1615  1.0000      -0.1424  0.0237
8  LSAS.SR_16a dif.edu -0.0440 0.0491 0.3701  1.0000      -0.1403  0.0523
9  LSAS.SR_18b dif.edu  0.1947 0.0416 0.0000  0.0000  ***  0.1131  0.2763
10 LSAS.SR_19a dif.edu -0.0573 0.0416 0.1685  1.0000      -0.1389  0.0243
11 LSAS.SR_22a dif.edu -0.0496 0.0413 0.2296  1.0000      -0.1304  0.0313
12 LSAS.SR_24a dif.edu  0.0032 0.0432 0.9416  1.0000      -0.0815  0.0878
Code
dif.yr <- dif %>% filter(Time=='PRE') %>% select(TreatmentAccessStart) %>% as.vector(.)
dif.yr <- dif.yr[[1]]
RIdifTable(df_ls, dif.yr)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.047 0.296 0.172 0.176 0.249
LSAS.SR_5b 0.101 0.083 0.092 0.013 0.019
LSAS.SR_8a 0.197 0.172 0.184 0.018 0.026
LSAS.SR_10a 0.025 -0.151 -0.063 0.125 0.177
LSAS.SR_11b 0.131 -0.025 0.053 0.111 0.156
LSAS.SR_12a -0.196 -0.242 -0.219 0.033 0.046
LSAS.SR_14a -0.267 -0.126 -0.196 0.100 0.141
LSAS.SR_16a -2.020 -1.489 -1.754 0.375 0.531
LSAS.SR_18b -0.434 -0.641 -0.537 0.146 0.206
LSAS.SR_19a 0.600 0.540 0.570 0.043 0.061
LSAS.SR_22a 0.615 0.700 0.658 0.060 0.085
LSAS.SR_24a 1.199 0.883 1.041 0.223 0.315
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.yr) 
          Item    Var   gamma     se pvalue padj.BH sig   lower   upper
1   LSAS.SR_2b dif.yr -0.1090 0.0310 0.0004  0.0053  ** -0.1698 -0.0482
2   LSAS.SR_5b dif.yr -0.0059 0.0305 0.8479  1.0000     -0.0657  0.0539
3   LSAS.SR_8a dif.yr  0.0191 0.0294 0.5155  1.0000     -0.0385  0.0767
4  LSAS.SR_10a dif.yr  0.0986 0.0302 0.0011  0.0132   *  0.0394  0.1578
5  LSAS.SR_11b dif.yr  0.0096 0.0326 0.7690  1.0000     -0.0543  0.0734
6  LSAS.SR_12a dif.yr -0.0756 0.0332 0.0228  0.2738     -0.1406 -0.0105
7  LSAS.SR_14a dif.yr -0.0783 0.0310 0.0116  0.1393     -0.1391 -0.0175
8  LSAS.SR_16a dif.yr -0.0935 0.0346 0.0068  0.0817   . -0.1612 -0.0258
9  LSAS.SR_18b dif.yr  0.1002 0.0299 0.0008  0.0096  **  0.0416  0.1587
10 LSAS.SR_19a dif.yr  0.0113 0.0296 0.7024  1.0000     -0.0467  0.0693
11 LSAS.SR_22a dif.yr -0.0284 0.0300 0.3429  1.0000     -0.0872  0.0303
12 LSAS.SR_24a dif.yr  0.0976 0.0305 0.0014  0.0167   *  0.0378  0.1574

11.1 Analysis part 2 decision

Most misfit is 11b and 12a both are cardinal symptoms. Both equally overfit (100%). 11b has slightly more residual correlations (12a not included). 11b has more DIF difference in age. 11b slight more overfit. Removing 11b.

12 Rasch analysis 3

Code
df_ls <- df_ls %>% select(!c(LSAS.SR_11b))
RIlistItemsMargin(df_ls, fontsize = 12)
itemnr item
LSAS.SR_2b small group avoid
LSAS.SR_5b talking authority avoid
LSAS.SR_8a work obs anxiety
LSAS.SR_10a call new anxiety
LSAS.SR_12a stranger anxiety
LSAS.SR_14a enter room anxiety
LSAS.SR_16a speaking up anxiety
LSAS.SR_18b disagreement avoid
LSAS.SR_19a eye contact anxiety
LSAS.SR_22a returning goods anxiety
LSAS.SR_24a resisting sales anxiety
Code
RIitemfit(df_ls, cutoff = "Smith98")
Item InfitMSQ Location 1 ± 2 / √n
LSAS.SR_2b 0.996 0.16 [0.95, 1.05]
LSAS.SR_5b 1.04 0.09 [0.95, 1.05]
LSAS.SR_8a 1.062 0.18 [0.95, 1.05]
LSAS.SR_10a 0.962 -0.05 [0.95, 1.05]
LSAS.SR_12a 0.829 -0.20 [0.95, 1.05]
LSAS.SR_14a 0.988 -0.19 [0.95, 1.05]
LSAS.SR_16a 1.129 -1.69 [0.95, 1.05]
LSAS.SR_18b 1.04 -0.52 [0.95, 1.05]
LSAS.SR_19a 1.017 0.56 [0.95, 1.05]
LSAS.SR_22a 1.005 0.64 [0.95, 1.05]
LSAS.SR_24a 1.009 1.02 [0.95, 1.05]
Note:
MSQ values based on conditional estimation (n = 1612 complete cases).
Code
# Getting error for estimating the simfit for LSAS. 
# Getting same error for week 2 and week 1 
#df_week02 <- df %>% filter(Time=='WEEK02') %>% select(!Time) 
simfit1 <- RIgetfit(df_ls, iterations = 300, cpu = n_cores)  # 

RIitemfit(df_ls, simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 0.996 [0.943, 1.073] 0.997 [0.935, 1.089] no misfit no misfit 0.16
LSAS.SR_5b 1.04 [0.929, 1.071] 1.043 [0.924, 1.081] no misfit no misfit 0.09
LSAS.SR_8a 1.062 [0.913, 1.093] 1.083 [0.908, 1.097] no misfit no misfit 0.18
LSAS.SR_10a 0.962 [0.93, 1.091] 0.962 [0.884, 1.122] no misfit no misfit -0.05
LSAS.SR_12a 0.829 [0.928, 1.082] 0.819 [0.907, 1.097] 0.099 0.088 -0.20
LSAS.SR_14a 0.988 [0.936, 1.06] 0.979 [0.927, 1.075] no misfit no misfit -0.19
LSAS.SR_16a 1.129 [0.93, 1.09] 1.096 [0.929, 1.123] 0.039 no misfit -1.69
LSAS.SR_18b 1.04 [0.928, 1.094] 1.052 [0.921, 1.107] no misfit no misfit -0.52
LSAS.SR_19a 1.017 [0.918, 1.086] 1.012 [0.908, 1.081] no misfit no misfit 0.56
LSAS.SR_22a 1.005 [0.933, 1.08] 0.986 [0.929, 1.088] no misfit no misfit 0.64
LSAS.SR_24a 1.009 [0.926, 1.085] 0.975 [0.925, 1.092] no misfit no misfit 1.02
Note:
MSQ values based on conditional calculations (n = 1612 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RIgetfitPlot(simfit1, df_ls)

Code
#skipped right now 
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 1:4, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[1:4])

### also suggested:
# library(RASCHplot) # install first with `devtools::install_github("ERRTG/RASCHplot")`
# CICCplot(PCM(df),
#          which.item = c(1:4),
#          lower.groups = c(0,7,14,21,28,35),
#          grid.items = TRUE)
Code
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 5:7, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[5:7])

This is severely limited due to the large number of items

Code
Item Observed value Model expected value Absolute difference Adjusted p-value (BH) Statistical significance level Location Relative location
LSAS.SR_2b 0.51 0.50 0.01 0.671 0.16 -0.14
LSAS.SR_5b 0.49 0.51 0.02 0.671 0.09 -0.21
LSAS.SR_8a 0.48 0.51 0.03 0.410 0.18 -0.12
LSAS.SR_10a 0.54 0.52 0.02 0.410 -0.05 -0.35
LSAS.SR_12a 0.61 0.50 0.11 0.000 *** -0.20 -0.50
LSAS.SR_14a 0.51 0.50 0.01 0.671 -0.19 -0.49
LSAS.SR_16a 0.45 0.49 0.04 0.397 -1.69 -1.98
LSAS.SR_18b 0.48 0.51 0.03 0.416 -0.52 -0.81
LSAS.SR_19a 0.50 0.51 0.01 0.671 0.56 0.26
LSAS.SR_22a 0.52 0.52 0.00 1.000 0.64 0.34
LSAS.SR_24a 0.53 0.52 0.01 0.671 1.02 0.72
Code
RIbootRestscore(df_ls,cpu=n_cores,iterations = 500,samplesize=800) # samplesize=600
Item Item-restscore result % of iterations Conditional MSQ infit Relative average item location
LSAS.SR_10a no misfit 95.8 0.96 -0.35
LSAS.SR_12a overfit 96.2 0.83 -0.50
LSAS.SR_14a no misfit 99.2 0.99 -0.49
LSAS.SR_16a no misfit 93.0 1.13 -1.98
LSAS.SR_16a underfit 7.0 1.13 -1.98
LSAS.SR_18b no misfit 98.6 1.04 -0.81
LSAS.SR_19a no misfit 99.6 1.02 0.26
LSAS.SR_22a no misfit 99.8 1.00 0.34
LSAS.SR_24a no misfit 99.4 1.01 0.72
LSAS.SR_2b no misfit 99.8 1.00 -0.14
LSAS.SR_5b no misfit 98.8 1.04 -0.21
LSAS.SR_8a no misfit 98.0 1.06 -0.12
Note:
Results based on 500 bootstrap iterations with a sample size of 800. Conditional mean-square infit based on complete responders only, n = 1612.
Code
RIpcmPCA(df_ls)
PCA of Rasch model residuals
Eigenvalues Proportion of variance
1.85 16.9%
1.38 12.7%
1.29 11.5%
1.14 10.6%
1.06 9.5%
Code
source('mod_easyRasch_func.R') # Reloading function req. 
simcor1 <- RIgetResidCor(df_ls, iterations = 500, cpu = n_cores) # 500
RIresidcorr(df_ls, cutoff = simcor1$p99)
LSAS.SR_2b LSAS.SR_5b LSAS.SR_8a LSAS.SR_10a LSAS.SR_12a LSAS.SR_14a LSAS.SR_16a LSAS.SR_18b LSAS.SR_19a LSAS.SR_22a LSAS.SR_24a
LSAS.SR_2b
LSAS.SR_5b 0.01
LSAS.SR_8a -0.14 -0.06
LSAS.SR_10a -0.24 -0.1 -0.12
LSAS.SR_12a 0 -0.16 -0.19 0.14
LSAS.SR_14a 0.05 -0.16 0.03 -0.24 -0.11
LSAS.SR_16a 0.19 -0.04 -0.04 -0.23 -0.14 0.1
LSAS.SR_18b -0.08 0 -0.16 -0.07 -0.07 -0.17 -0.05
LSAS.SR_19a -0.11 -0.08 -0.12 -0.12 0.05 -0.06 -0.11 -0.11
LSAS.SR_22a -0.21 -0.18 -0.05 0.01 -0.07 -0.11 -0.22 -0.15 -0.12
LSAS.SR_24a -0.23 -0.15 -0.12 0.05 -0.1 -0.14 -0.21 -0.05 -0.14 0.14
Note:
Relative cut-off value is 0.011, which is 0.098 above the average correlation (-0.087).
Correlations above the cut-off are highlighted in red text.
Code
Item 1 Item 2 Partial gamma SE Lower CI Upper CI Adjusted p-value (BH)
LSAS.SR_2b LSAS.SR_16a 0.429 0.040 0.351 0.507 0.000
LSAS.SR_16a LSAS.SR_2b 0.424 0.040 0.346 0.502 0.000
LSAS.SR_12a LSAS.SR_10a 0.332 0.037 0.259 0.405 0.000
LSAS.SR_24a LSAS.SR_22a 0.331 0.036 0.261 0.402 0.000
LSAS.SR_22a LSAS.SR_24a 0.326 0.036 0.255 0.396 0.000
LSAS.SR_14a LSAS.SR_16a 0.285 0.043 0.200 0.370 0.000
LSAS.SR_10a LSAS.SR_12a 0.281 0.039 0.204 0.357 0.000
LSAS.SR_16a LSAS.SR_14a 0.27 0.043 0.186 0.353 0.000
LSAS.SR_12a LSAS.SR_19a 0.235 0.039 0.157 0.312 0.000
LSAS.SR_10a LSAS.SR_24a 0.219 0.037 0.145 0.292 0.000
LSAS.SR_24a LSAS.SR_10a 0.208 0.038 0.135 0.282 0.000
LSAS.SR_2b LSAS.SR_14a 0.202 0.040 0.124 0.280 0.000
LSAS.SR_14a LSAS.SR_2b 0.194 0.040 0.115 0.272 0.000
LSAS.SR_14a LSAS.SR_8a 0.184 0.039 0.108 0.260 0.000
LSAS.SR_19a LSAS.SR_12a 0.184 0.039 0.108 0.260 0.000
LSAS.SR_10a LSAS.SR_22a 0.177 0.038 0.103 0.251 0.000
LSAS.SR_8a LSAS.SR_14a 0.172 0.039 0.096 0.249 0.001
LSAS.SR_12a LSAS.SR_2b 0.163 0.041 0.083 0.243 0.008
LSAS.SR_22a LSAS.SR_10a 0.156 0.038 0.081 0.231 0.005
Code
RIloadLoc(df_ls)

Code
mirt(df_ls, model=1, itemtype='Rasch', verbose = FALSE) %>% 
  plot(type="trace", as.table = TRUE, 
       theta_lim = c(-6,6))

Code
# for fewer items or a more magnified figure, use:
#RIitemCats(df)
Code
# increase fig-height above as needed, if you have many items
RItargeting(df_ls)

Code

Code
iarm::score_groups(as.data.frame(df_ls)) %>% 
  as.data.frame(nm = "score_group") %>% 
  dplyr::count(score_group)
  score_group   n
1           1 773
2           2 839
Code
dif_plots <- df_ls %>% 
  add_column(dif = iarm::score_groups(.)) %>% 
  split(.$dif) %>% # split the data using the DIF variable
  map(~ RItileplot(.x %>% dplyr::select(!dif)) + labs(title = .x$dif))
dif_plots[[1]] + dif_plots[[2]]

Code
clr_tests(df_ls, model = "PCM")

Conditional Likelihood Ratio Tests:
        clr  df pvalue  sig 
overall 66.3 32 0.00034  ***
Code 
Score group 1: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.0531   1.0664  -0.5667    
LSAS.SR_5b   1.0829   1.0637   0.7894    
LSAS.SR_8a   1.0687   1.0557   0.4959    
LSAS.SR_10a  1.1490   1.1476   0.0497    
LSAS.SR_12a  1.2319   1.2895  -2.1928 -  
LSAS.SR_14a  1.2358   1.2591  -0.9107    
LSAS.SR_16a  2.1865   2.1708   0.6360    
LSAS.SR_18b  1.4560   1.4216   1.2730    
LSAS.SR_19a  0.8109   0.8016   0.3671    
LSAS.SR_22a  0.7293   0.7165   0.5054    
LSAS.SR_24a  0.4883   0.4998  -0.4993    

Score group 2: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.9353   1.9229   0.4936    
LSAS.SR_5b   1.9760   1.9938  -0.6871    
LSAS.SR_8a   2.0192   2.0312  -0.4792    
LSAS.SR_10a  2.2422   2.2435  -0.0514    
LSAS.SR_12a  2.2626   2.2093   2.2520 +  
LSAS.SR_14a  2.1954   2.1738   0.8944    
LSAS.SR_16a  2.7482   2.7627  -0.9278    
LSAS.SR_18b  2.3465   2.3784  -1.3601    
LSAS.SR_19a  1.8177   1.8264  -0.3229    
LSAS.SR_22a  1.7770   1.7888  -0.4265    
LSAS.SR_24a  1.5324   1.5218   0.3715
Code
grouping_based_on_score = score_groups(as.data.frame(df_ls))
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = grouping_based_on_score) 
          Item                     Var gamma  se pvalue padj.BH sig lower upper
1   LSAS.SR_2b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
2   LSAS.SR_5b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
3   LSAS.SR_8a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
4  LSAS.SR_10a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
5  LSAS.SR_12a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
6  LSAS.SR_14a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
7  LSAS.SR_16a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
8  LSAS.SR_18b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
9  LSAS.SR_19a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
10 LSAS.SR_22a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
11 LSAS.SR_24a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
Code
dif.sex <- dif %>% filter(Time=='PRE') %>% select(sex) %>% as.vector(.)
dif.sex <- dif.sex[[1]] #female = 1, male = 2 
RIdifTable(df_ls, dif.sex)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.244 0.057 0.150 0.132 0.187
LSAS.SR_5b 0.114 0.066 0.090 0.034 0.048
LSAS.SR_8a 0.048 0.365 0.207 0.224 0.317
LSAS.SR_10a -0.093 0.013 -0.040 0.075 0.106
LSAS.SR_12a -0.111 -0.327 -0.219 0.153 0.217
LSAS.SR_14a -0.242 -0.101 -0.171 0.100 0.141
LSAS.SR_16a -1.890 -1.506 -1.698 0.271 0.384
LSAS.SR_18b -0.525 -0.496 -0.510 0.021 0.029
LSAS.SR_19a 0.684 0.397 0.540 0.203 0.287
LSAS.SR_22a 0.746 0.500 0.623 0.174 0.246
LSAS.SR_24a 1.024 1.032 1.028 0.006 0.008
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.sex) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.sex  0.1003 0.0474 0.0342  0.3762       0.0075  0.1932
2   LSAS.SR_5b dif.sex -0.0226 0.0473 0.6327  1.0000      -0.1154  0.0701
3   LSAS.SR_8a dif.sex -0.1969 0.0451 0.0000  0.0001  *** -0.2852 -0.1086
4  LSAS.SR_10a dif.sex -0.0829 0.0464 0.0739  0.8132      -0.1737  0.0080
5  LSAS.SR_12a dif.sex  0.1482 0.0488 0.0024  0.0265    *  0.0525  0.2440
6  LSAS.SR_14a dif.sex -0.1331 0.0471 0.0048  0.0523    . -0.2255 -0.0407
7  LSAS.SR_16a dif.sex -0.2542 0.0508 0.0000  0.0000  *** -0.3537 -0.1547
8  LSAS.SR_18b dif.sex -0.0380 0.0470 0.4181  1.0000      -0.1301  0.0540
9  LSAS.SR_19a dif.sex  0.1680 0.0449 0.0002  0.0020   **  0.0800  0.2559
10 LSAS.SR_22a dif.sex  0.2153 0.0444 0.0000  0.0000  ***  0.1283  0.3024
11 LSAS.SR_24a dif.sex  0.0667 0.0473 0.1582  1.0000      -0.0259  0.1594
Code
dif.age <- dif %>% filter(Time=='PRE') %>% select(age) %>% as.vector(.)
dif.age <- dif.age[[1]]
RIdifTable(df_ls, dif.age)

Item 4 6 7 8 9 Mean location StDev MaxDiff
LSAS.SR_2b -0.091 0.181 0.177 0.178 0.107 0.110 0.117 0.272
LSAS.SR_5b 0.642 0.314 -0.332 0.087 -0.027 0.137 0.366 0.974
LSAS.SR_8a 0.267 0.348 0.151 0.179 0.093 0.208 0.101 0.255
LSAS.SR_10a -0.357 -0.292 -0.242 -0.091 0.199 -0.156 0.222 0.556
LSAS.SR_12a -0.665 -0.501 -0.364 -0.160 -0.098 -0.358 0.235 0.567
LSAS.SR_14a -0.187 -0.198 0.097 -0.124 -0.403 -0.163 0.179 0.500
LSAS.SR_16a -1.340 -1.621 -0.754 -1.697 -1.987 -1.480 0.466 1.232
LSAS.SR_18b -0.613 -0.276 -0.322 -0.573 -0.524 -0.462 0.153 0.337
LSAS.SR_19a 1.156 0.634 0.332 0.509 0.685 0.663 0.307 0.824
LSAS.SR_22a 0.518 0.468 0.354 0.653 0.881 0.575 0.202 0.527
LSAS.SR_24a 0.671 0.944 0.904 1.039 1.072 0.926 0.158 0.402
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.age) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.age  0.0339 0.0293 0.2465  1.0000      -0.0235  0.0914
2   LSAS.SR_5b dif.age  0.0587 0.0291 0.0436  0.4791       0.0017  0.1157
3   LSAS.SR_8a dif.age  0.0619 0.0276 0.0250  0.2752       0.0078  0.1160
4  LSAS.SR_10a dif.age -0.1301 0.0272 0.0000  0.0000  *** -0.1834 -0.0767
5  LSAS.SR_12a dif.age -0.0657 0.0311 0.0345  0.3792      -0.1266 -0.0048
6  LSAS.SR_14a dif.age  0.0560 0.0281 0.0465  0.5112       0.0009  0.1111
7  LSAS.SR_16a dif.age  0.0841 0.0325 0.0097  0.1063       0.0204  0.1479
8  LSAS.SR_18b dif.age  0.0215 0.0285 0.4515  1.0000      -0.0344  0.0774
9  LSAS.SR_19a dif.age -0.0331 0.0277 0.2327  1.0000      -0.0875  0.0213
10 LSAS.SR_22a dif.age -0.0408 0.0282 0.1476  1.0000      -0.0961  0.0144
11 LSAS.SR_24a dif.age -0.0296 0.0281 0.2913  1.0000      -0.0847  0.0254
Code
dif.edu <- dif %>% filter(Time=='PRE') %>% select(education) %>% as.vector(.)
dif.edu <- dif.edu[[1]]
RIdifTable(df_ls, dif.edu)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.074 0.298 0.186 0.158 0.224
LSAS.SR_5b 0.209 -0.053 0.078 0.185 0.262
LSAS.SR_8a 0.236 0.108 0.172 0.090 0.128
LSAS.SR_10a -0.036 -0.046 -0.041 0.007 0.010
LSAS.SR_12a -0.340 -0.061 -0.200 0.197 0.278
LSAS.SR_14a -0.194 -0.181 -0.188 0.009 0.013
LSAS.SR_16a -1.755 -1.681 -1.718 0.052 0.074
LSAS.SR_18b -0.383 -0.667 -0.525 0.201 0.285
LSAS.SR_19a 0.525 0.608 0.566 0.059 0.084
LSAS.SR_22a 0.636 0.670 0.653 0.024 0.034
LSAS.SR_24a 1.028 1.006 1.017 0.016 0.022
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.edu) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.edu -0.1270 0.0427 0.0030  0.0325    * -0.2107 -0.0433
2   LSAS.SR_5b dif.edu  0.1694 0.0419 0.0001  0.0006  ***  0.0873  0.2515
3   LSAS.SR_8a dif.edu  0.0786 0.0418 0.0599  0.6586      -0.0033  0.1605
4  LSAS.SR_10a dif.edu -0.0077 0.0425 0.8560  1.0000      -0.0909  0.0755
5  LSAS.SR_12a dif.edu -0.0965 0.0449 0.0316  0.3477      -0.1846 -0.0085
6  LSAS.SR_14a dif.edu -0.0644 0.0426 0.1301  1.0000      -0.1479  0.0190
7  LSAS.SR_16a dif.edu -0.0390 0.0493 0.4286  1.0000      -0.1357  0.0576
8  LSAS.SR_18b dif.edu  0.1816 0.0415 0.0000  0.0001  ***  0.1002  0.2630
9  LSAS.SR_19a dif.edu -0.0644 0.0416 0.1217  1.0000      -0.1459  0.0171
10 LSAS.SR_22a dif.edu -0.0529 0.0416 0.2037  1.0000      -0.1345  0.0287
11 LSAS.SR_24a dif.edu -0.0013 0.0433 0.9758  1.0000      -0.0861  0.0835
Code
dif.yr <- dif %>% filter(Time=='PRE') %>% select(TreatmentAccessStart) %>% as.vector(.)
dif.yr <- dif.yr[[1]]
RIdifTable(df_ls, dif.yr)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.056 0.287 0.171 0.164 0.232
LSAS.SR_5b 0.107 0.077 0.092 0.021 0.030
LSAS.SR_8a 0.202 0.167 0.184 0.025 0.035
LSAS.SR_10a 0.034 -0.150 -0.058 0.130 0.184
LSAS.SR_12a -0.180 -0.240 -0.210 0.042 0.060
LSAS.SR_14a -0.249 -0.126 -0.187 0.087 0.122
LSAS.SR_16a -1.941 -1.461 -1.701 0.340 0.481
LSAS.SR_18b -0.413 -0.632 -0.522 0.155 0.219
LSAS.SR_19a 0.595 0.528 0.561 0.048 0.068
LSAS.SR_22a 0.609 0.685 0.647 0.053 0.076
LSAS.SR_24a 1.179 0.864 1.022 0.223 0.315
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.yr) 
          Item    Var   gamma     se pvalue padj.BH sig   lower   upper
1   LSAS.SR_2b dif.yr -0.1033 0.0304 0.0007  0.0075  ** -0.1630 -0.0437
2   LSAS.SR_5b dif.yr -0.0059 0.0300 0.8445  1.0000     -0.0647  0.0530
3   LSAS.SR_8a dif.yr  0.0207 0.0295 0.4840  1.0000     -0.0372  0.0785
4  LSAS.SR_10a dif.yr  0.1034 0.0301 0.0006  0.0064  **  0.0445  0.1623
5  LSAS.SR_12a dif.yr -0.0625 0.0327 0.0558  0.6138     -0.1266  0.0015
6  LSAS.SR_14a dif.yr -0.0734 0.0311 0.0184  0.2024     -0.1344 -0.0124
7  LSAS.SR_16a dif.yr -0.0856 0.0348 0.0139  0.1532     -0.1538 -0.0174
8  LSAS.SR_18b dif.yr  0.0988 0.0298 0.0009  0.0099  **  0.0404  0.1571
9  LSAS.SR_19a dif.yr  0.0108 0.0291 0.7120  1.0000     -0.0463  0.0678
10 LSAS.SR_22a dif.yr -0.0343 0.0302 0.2567  1.0000     -0.0935  0.0249
11 LSAS.SR_24a dif.yr  0.0845 0.0304 0.0055  0.0604   .  0.0249  0.1442

12.1 Analysis part 3 decision

Trying remove 12a

13 Rasch analysis 4

Removing 12a

Code
df_ls <- df_ls %>% select(!c(LSAS.SR_12a))
RIlistItemsMargin(df_ls, fontsize = 12)
itemnr item
LSAS.SR_2b small group avoid
LSAS.SR_5b talking authority avoid
LSAS.SR_8a work obs anxiety
LSAS.SR_10a call new anxiety
LSAS.SR_14a enter room anxiety
LSAS.SR_16a speaking up anxiety
LSAS.SR_18b disagreement avoid
LSAS.SR_19a eye contact anxiety
LSAS.SR_22a returning goods anxiety
LSAS.SR_24a resisting sales anxiety
Code
RIitemfit(df_ls, cutoff = "Smith98")
Item InfitMSQ Location 1 ± 2 / √n
LSAS.SR_2b 0.987 0.14 [0.95, 1.05]
LSAS.SR_5b 1.003 0.07 [0.95, 1.05]
LSAS.SR_8a 1.02 0.16 [0.95, 1.05]
LSAS.SR_10a 0.986 -0.07 [0.95, 1.05]
LSAS.SR_14a 0.962 -0.21 [0.95, 1.05]
LSAS.SR_16a 1.086 -1.67 [0.95, 1.05]
LSAS.SR_18b 1.023 -0.52 [0.95, 1.05]
LSAS.SR_19a 1.021 0.53 [0.95, 1.05]
LSAS.SR_22a 0.984 0.61 [0.95, 1.05]
LSAS.SR_24a 0.981 0.98 [0.95, 1.05]
Note:
MSQ values based on conditional estimation (n = 1612 complete cases).
Code
# Getting error for estimating the simfit for LSAS. 
# Getting same error for week 2 and week 1 
#df_week02 <- df %>% filter(Time=='WEEK02') %>% select(!Time) 
simfit1 <- RIgetfit(df_ls, iterations = 300, cpu = n_cores)  # 

RIitemfit(df_ls, simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 0.987 [0.929, 1.078] 0.986 [0.916, 1.091] no misfit no misfit 0.14
LSAS.SR_5b 1.003 [0.935, 1.064] 1.001 [0.919, 1.065] no misfit no misfit 0.07
LSAS.SR_8a 1.02 [0.917, 1.064] 1.042 [0.878, 1.133] no misfit no misfit 0.16
LSAS.SR_10a 0.986 [0.905, 1.091] 0.985 [0.892, 1.115] no misfit no misfit -0.07
LSAS.SR_14a 0.962 [0.933, 1.088] 0.953 [0.92, 1.113] no misfit no misfit -0.21
LSAS.SR_16a 1.086 [0.929, 1.084] 1.056 [0.916, 1.08] 0.002 no misfit -1.67
LSAS.SR_18b 1.023 [0.926, 1.081] 1.037 [0.908, 1.11] no misfit no misfit -0.52
LSAS.SR_19a 1.021 [0.909, 1.057] 1.015 [0.902, 1.057] no misfit no misfit 0.53
LSAS.SR_22a 0.984 [0.913, 1.067] 0.968 [0.903, 1.077] no misfit no misfit 0.61
LSAS.SR_24a 0.981 [0.916, 1.092] 0.949 [0.91, 1.099] no misfit no misfit 0.98
Note:
MSQ values based on conditional calculations (n = 1612 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RIgetfitPlot(simfit1, df_ls)

Code
#skipped right now 
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 1:4, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[1:4])

### also suggested:
# library(RASCHplot) # install first with `devtools::install_github("ERRTG/RASCHplot")`
# CICCplot(PCM(df),
#          which.item = c(1:4),
#          lower.groups = c(0,7,14,21,28,35),
#          grid.items = TRUE)
Code
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 5:7, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[5:7])

This is severely limited due to the large number of items

Code
Item Observed value Model expected value Absolute difference Adjusted p-value (BH) Statistical significance level Location Relative location
LSAS.SR_2b 0.50 0.49 0.01 0.656 0.14 -0.14
LSAS.SR_5b 0.50 0.49 0.01 0.858 0.07 -0.21
LSAS.SR_8a 0.49 0.49 0.00 0.858 0.16 -0.11
LSAS.SR_10a 0.52 0.50 0.02 0.656 -0.07 -0.34
LSAS.SR_14a 0.51 0.49 0.02 0.656 -0.21 -0.48
LSAS.SR_16a 0.45 0.47 0.02 0.656 -1.67 -1.94
LSAS.SR_18b 0.48 0.49 0.01 0.656 -0.52 -0.80
LSAS.SR_19a 0.48 0.50 0.02 0.656 0.53 0.26
LSAS.SR_22a 0.51 0.50 0.01 0.656 0.61 0.33
LSAS.SR_24a 0.52 0.50 0.02 0.656 0.98 0.71
Code
RIbootRestscore(df_ls,cpu=n_cores,iterations = 500,samplesize=800) # samplesize=600
Item Item-restscore result % of iterations Conditional MSQ infit Relative average item location
LSAS.SR_10a no misfit 99.2 0.99 -0.34
LSAS.SR_14a no misfit 98.6 0.96 -0.48
LSAS.SR_16a no misfit 99.2 1.09 -1.94
LSAS.SR_18b no misfit 100.0 1.02 -0.80
LSAS.SR_19a no misfit 99.6 1.02 0.26
LSAS.SR_22a no misfit 99.8 0.98 0.33
LSAS.SR_24a no misfit 97.4 0.98 0.71
LSAS.SR_2b no misfit 99.8 0.99 -0.14
LSAS.SR_5b no misfit 100.0 1.00 -0.21
LSAS.SR_8a no misfit 99.6 1.02 -0.11
Note:
Results based on 500 bootstrap iterations with a sample size of 800. Conditional mean-square infit based on complete responders only, n = 1612.
Code
RIpcmPCA(df_ls)
PCA of Rasch model residuals
Eigenvalues Proportion of variance
1.84 18.2%
1.36 13.8%
1.15 11.6%
1.13 11.5%
1.01 10.3%
Code
source('mod_easyRasch_func.R') # Reloading function req. 
simcor1 <- RIgetResidCor(df_ls, iterations = 500, cpu = n_cores) # 500
RIresidcorr(df_ls, cutoff = simcor1$p99)
LSAS.SR_2b LSAS.SR_5b LSAS.SR_8a LSAS.SR_10a LSAS.SR_14a LSAS.SR_16a LSAS.SR_18b LSAS.SR_19a LSAS.SR_22a LSAS.SR_24a
LSAS.SR_2b
LSAS.SR_5b 0
LSAS.SR_8a -0.14 -0.08
LSAS.SR_10a -0.22 -0.09 -0.12
LSAS.SR_14a 0.05 -0.17 0.01 -0.22
LSAS.SR_16a 0.19 -0.06 -0.06 -0.23 0.09
LSAS.SR_18b -0.08 -0.01 -0.18 -0.06 -0.18 -0.06
LSAS.SR_19a -0.1 -0.08 -0.12 -0.09 -0.06 -0.11 -0.1
LSAS.SR_22a -0.21 -0.19 -0.07 0.03 -0.12 -0.23 -0.15 -0.11
LSAS.SR_24a -0.23 -0.16 -0.13 0.06 -0.15 -0.23 -0.06 -0.14 0.13
Note:
Relative cut-off value is 0.004, which is 0.099 above the average correlation (-0.094).
Correlations above the cut-off are highlighted in red text.
Code
Item 1 Item 2 Partial gamma SE Lower CI Upper CI Adjusted p-value (BH)
LSAS.SR_2b LSAS.SR_16a 0.429 0.039 0.351 0.506 0.000
LSAS.SR_16a LSAS.SR_2b 0.423 0.040 0.345 0.501 0.000
LSAS.SR_24a LSAS.SR_22a 0.335 0.036 0.264 0.406 0.000
LSAS.SR_22a LSAS.SR_24a 0.328 0.036 0.257 0.398 0.000
LSAS.SR_14a LSAS.SR_16a 0.271 0.043 0.188 0.355 0.000
LSAS.SR_16a LSAS.SR_14a 0.258 0.043 0.174 0.342 0.000
LSAS.SR_24a LSAS.SR_10a 0.24 0.036 0.168 0.311 0.000
LSAS.SR_10a LSAS.SR_24a 0.238 0.037 0.166 0.310 0.000
LSAS.SR_14a LSAS.SR_2b 0.202 0.039 0.125 0.280 0.000
LSAS.SR_10a LSAS.SR_22a 0.199 0.037 0.126 0.272 0.000
LSAS.SR_2b LSAS.SR_14a 0.197 0.039 0.120 0.275 0.000
LSAS.SR_22a LSAS.SR_10a 0.192 0.037 0.119 0.265 0.000
LSAS.SR_14a LSAS.SR_8a 0.171 0.039 0.095 0.248 0.001
LSAS.SR_8a LSAS.SR_14a 0.152 0.039 0.075 0.228 0.009
Code
RIloadLoc(df_ls)

Code
mirt(df_ls, model=1, itemtype='Rasch', verbose = FALSE) %>% 
  plot(type="trace", as.table = TRUE, 
       theta_lim = c(-6,6))

Code
# for fewer items or a more magnified figure, use:
#RIitemCats(df)
Code
# increase fig-height above as needed, if you have many items
RItargeting(df_ls)

Code

Code
iarm::score_groups(as.data.frame(df_ls)) %>% 
  as.data.frame(nm = "score_group") %>% 
  dplyr::count(score_group)
  score_group   n
1           1 843
2           2 769
Code
dif_plots <- df_ls %>% 
  add_column(dif = iarm::score_groups(.)) %>% 
  split(.$dif) %>% # split the data using the DIF variable
  map(~ RItileplot(.x %>% dplyr::select(!dif)) + labs(title = .x$dif))
dif_plots[[1]] + dif_plots[[2]]

Code
clr_tests(df_ls, model = "PCM")

Conditional Likelihood Ratio Tests:
        clr  df pvalue sig
overall 37.6 29 0.13
Code 
Score group 1: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.0998   1.1041  -0.1902    
LSAS.SR_5b   1.1045   1.1041   0.0154    
LSAS.SR_8a   1.1081   1.1022   0.2325    
LSAS.SR_10a  1.2019   1.2024  -0.0187    
LSAS.SR_14a  1.2827   1.3034  -0.8364    
LSAS.SR_16a  2.2102   2.2083   0.0827    
LSAS.SR_18b  1.4846   1.4709   0.5254    
LSAS.SR_19a  0.8563   0.8465   0.3973    
LSAS.SR_22a  0.7696   0.7615   0.3273    
LSAS.SR_24a  0.5238   0.5380  -0.6276    

Score group 2: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.9647   1.9599   0.1824    
LSAS.SR_5b   2.0340   2.0344  -0.0152    
LSAS.SR_8a   2.0628   2.0693  -0.2481    
LSAS.SR_10a  2.2840   2.2835   0.0219    
LSAS.SR_14a  2.2317   2.2088   0.9079    
LSAS.SR_16a  2.7736   2.7757  -0.1329    
LSAS.SR_18b  2.3966   2.4117  -0.6245    
LSAS.SR_19a  1.8599   1.8708  -0.3870    
LSAS.SR_22a  1.8285   1.8374  -0.3072    
LSAS.SR_24a  1.5890   1.5733   0.5207
Code
grouping_based_on_score = score_groups(as.data.frame(df_ls))
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = grouping_based_on_score) 
          Item                     Var gamma  se pvalue padj.BH sig lower upper
1   LSAS.SR_2b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
2   LSAS.SR_5b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
3   LSAS.SR_8a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
4  LSAS.SR_10a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
5  LSAS.SR_14a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
6  LSAS.SR_16a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
7  LSAS.SR_18b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
8  LSAS.SR_19a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
9  LSAS.SR_22a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
10 LSAS.SR_24a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
Code
dif.sex <- dif %>% filter(Time=='PRE') %>% select(sex) %>% as.vector(.)
dif.sex <- dif.sex[[1]] #female = 1, male = 2 
RIdifTable(df_ls, dif.sex)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.227 0.022 0.124 0.144 0.204
LSAS.SR_5b 0.100 0.031 0.065 0.049 0.069
LSAS.SR_8a 0.038 0.327 0.182 0.204 0.289
LSAS.SR_10a -0.101 -0.019 -0.060 0.058 0.081
LSAS.SR_14a -0.247 -0.132 -0.189 0.082 0.115
LSAS.SR_16a -1.861 -1.508 -1.684 0.250 0.353
LSAS.SR_18b -0.525 -0.519 -0.522 0.004 0.005
LSAS.SR_19a 0.659 0.357 0.508 0.213 0.302
LSAS.SR_22a 0.720 0.459 0.590 0.184 0.260
LSAS.SR_24a 0.991 0.981 0.986 0.007 0.009
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.sex) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.sex  0.1127 0.0472 0.0170  0.1701       0.0201  0.2052
2   LSAS.SR_5b dif.sex -0.0016 0.0472 0.9737  1.0000      -0.0941  0.0910
3   LSAS.SR_8a dif.sex -0.1944 0.0447 0.0000  0.0001  *** -0.2820 -0.1068
4  LSAS.SR_10a dif.sex -0.0699 0.0458 0.1274  1.0000      -0.1597  0.0200
5  LSAS.SR_14a dif.sex -0.1198 0.0467 0.0102  0.1024      -0.2113 -0.0284
6  LSAS.SR_16a dif.sex -0.2525 0.0509 0.0000  0.0000  *** -0.3523 -0.1527
7  LSAS.SR_18b dif.sex -0.0182 0.0467 0.6972  1.0000      -0.1097  0.0734
8  LSAS.SR_19a dif.sex  0.1813 0.0444 0.0000  0.0004  ***  0.0942  0.2683
9  LSAS.SR_22a dif.sex  0.2171 0.0440 0.0000  0.0000  ***  0.1308  0.3034
10 LSAS.SR_24a dif.sex  0.0879 0.0472 0.0626  0.6259      -0.0046  0.1805
Code
dif.age <- dif %>% filter(Time=='PRE') %>% select(age) %>% as.vector(.)
dif.age <- dif.age[[1]]
RIdifTable(df_ls, dif.age)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.143 0.094 0.118 0.035 0.050
LSAS.SR_5b 0.093 -0.009 0.042 0.073 0.103
LSAS.SR_8a 0.180 0.086 0.133 0.066 0.093
LSAS.SR_10a -0.185 0.163 -0.011 0.246 0.349
LSAS.SR_14a -0.139 -0.387 -0.263 0.176 0.248
LSAS.SR_16a -1.496 -2.026 -1.761 0.375 0.531
LSAS.SR_18b -0.521 -0.532 -0.527 0.008 0.011
LSAS.SR_19a 0.466 0.649 0.558 0.129 0.183
LSAS.SR_22a 0.522 0.888 0.705 0.259 0.366
LSAS.SR_24a 0.937 1.075 1.006 0.097 0.138
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.age) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.age  0.0292 0.0292 0.3183  1.0000      -0.0281  0.0865
2   LSAS.SR_5b dif.age  0.0539 0.0290 0.0633  0.6327      -0.0030  0.1108
3   LSAS.SR_8a dif.age  0.0647 0.0274 0.0180  0.1795       0.0111  0.1183
4  LSAS.SR_10a dif.age -0.1420 0.0272 0.0000  0.0000  *** -0.1953 -0.0887
5  LSAS.SR_14a dif.age  0.0614 0.0284 0.0305  0.3048       0.0058  0.1170
6  LSAS.SR_16a dif.age  0.0901 0.0326 0.0057  0.0573    .  0.0262  0.1540
7  LSAS.SR_18b dif.age  0.0122 0.0285 0.6681  1.0000      -0.0436  0.0680
8  LSAS.SR_19a dif.age -0.0464 0.0277 0.0938  0.9384      -0.1006  0.0079
9  LSAS.SR_22a dif.age -0.0551 0.0276 0.0454  0.4542      -0.1092 -0.0011
10 LSAS.SR_24a dif.age -0.0367 0.0279 0.1880  1.0000      -0.0913  0.0179
Code
dif.edu <- dif %>% filter(Time=='PRE') %>% select(education) %>% as.vector(.)
dif.edu <- dif.edu[[1]]
RIdifTable(df_ls, dif.edu)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.038 0.285 0.162 0.175 0.248
LSAS.SR_5b 0.172 -0.059 0.057 0.164 0.231
LSAS.SR_8a 0.200 0.101 0.151 0.070 0.099
LSAS.SR_10a -0.066 -0.051 -0.059 0.011 0.015
LSAS.SR_14a -0.224 -0.184 -0.204 0.029 0.041
LSAS.SR_16a -1.766 -1.650 -1.708 0.082 0.116
LSAS.SR_18b -0.410 -0.660 -0.535 0.177 0.250
LSAS.SR_19a 0.484 0.590 0.537 0.075 0.106
LSAS.SR_22a 0.594 0.650 0.622 0.039 0.056
LSAS.SR_24a 0.978 0.978 0.978 0.000 0.000
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.edu) 
          Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1   LSAS.SR_2b dif.edu -0.1424 0.0424 0.0008  0.0077   ** -0.2254 -0.0594
2   LSAS.SR_5b dif.edu  0.1657 0.0425 0.0001  0.0010  ***  0.0824  0.2491
3   LSAS.SR_8a dif.edu  0.0903 0.0416 0.0300  0.2997       0.0088  0.1719
4  LSAS.SR_10a dif.edu -0.0217 0.0419 0.6048  1.0000      -0.1037  0.0604
5  LSAS.SR_14a dif.edu -0.0659 0.0422 0.1185  1.0000      -0.1487  0.0168
6  LSAS.SR_16a dif.edu -0.0438 0.0491 0.3731  1.0000      -0.1401  0.0525
7  LSAS.SR_18b dif.edu  0.1707 0.0411 0.0000  0.0003  ***  0.0901  0.2514
8  LSAS.SR_19a dif.edu -0.0782 0.0412 0.0579  0.5790      -0.1589  0.0026
9  LSAS.SR_22a dif.edu -0.0591 0.0414 0.1534  1.0000      -0.1403  0.0220
10 LSAS.SR_24a dif.edu -0.0112 0.0433 0.7956  1.0000      -0.0962  0.0737
Code
dif.yr <- dif %>% filter(Time=='PRE') %>% select(TreatmentAccessStart) %>% as.vector(.)
dif.yr <- dif.yr[[1]]
RIdifTable(df_ls, dif.yr)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.064 0.282 0.173 0.154 0.218
LSAS.SR_5b 0.075 0.058 0.066 0.012 0.017
LSAS.SR_8a 0.175 0.133 0.154 0.030 0.042
LSAS.SR_10a -0.001 -0.198 -0.099 0.140 0.198
LSAS.SR_14a -0.271 -0.095 -0.183 0.125 0.176
LSAS.SR_16a -1.859 -1.387 -1.623 0.334 0.472
LSAS.SR_18b -0.437 -0.710 -0.574 0.193 0.273
LSAS.SR_19a 0.540 0.520 0.530 0.014 0.020
LSAS.SR_22a 0.609 0.619 0.614 0.007 0.010
LSAS.SR_24a 1.105 0.779 0.942 0.231 0.326
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.yr) 
          Item    Var   gamma     se pvalue padj.BH sig   lower   upper
1   LSAS.SR_2b dif.yr -0.1110 0.0306 0.0003  0.0029  ** -0.1710 -0.0510
2   LSAS.SR_5b dif.yr -0.0135 0.0300 0.6531  1.0000     -0.0722  0.0453
3   LSAS.SR_8a dif.yr  0.0150 0.0297 0.6144  1.0000     -0.0433  0.0733
4  LSAS.SR_10a dif.yr  0.0910 0.0298 0.0023  0.0226   *  0.0326  0.1494
5  LSAS.SR_14a dif.yr -0.0781 0.0312 0.0122  0.1225     -0.1392 -0.0170
6  LSAS.SR_16a dif.yr -0.0885 0.0341 0.0096  0.0955   . -0.1554 -0.0216
7  LSAS.SR_18b dif.yr  0.0948 0.0297 0.0014  0.0143   *  0.0365  0.1531
8  LSAS.SR_19a dif.yr  0.0028 0.0289 0.9214  1.0000     -0.0538  0.0595
9  LSAS.SR_22a dif.yr -0.0439 0.0299 0.1426  1.0000     -0.1026  0.0148
10 LSAS.SR_24a dif.yr  0.0870 0.0301 0.0039  0.0387   *  0.0280  0.1460

13.1 Analysis part 4 decision

Item 16a does seem to have problems across several dimensions except the boostrapped itemfit. Residual correlations, partial gamma, and DIF on age. We try to remove it .

14 Rasch analysis 5

Removing 16a

Code
df_ls <- df_ls %>% select(!c(LSAS.SR_16a))
RIlistItemsMargin(df_ls, fontsize = 12)
itemnr item
LSAS.SR_2b small group avoid
LSAS.SR_5b talking authority avoid
LSAS.SR_8a work obs anxiety
LSAS.SR_10a call new anxiety
LSAS.SR_14a enter room anxiety
LSAS.SR_18b disagreement avoid
LSAS.SR_19a eye contact anxiety
LSAS.SR_22a returning goods anxiety
LSAS.SR_24a resisting sales anxiety
Code
RIitemfit(df_ls, cutoff = "Smith98")
Item InfitMSQ Location 1 ± 2 / √n
LSAS.SR_2b 1.036 -0.05 [0.95, 1.05]
LSAS.SR_5b 1.011 -0.12 [0.95, 1.05]
LSAS.SR_8a 1.031 -0.03 [0.95, 1.05]
LSAS.SR_10a 0.966 -0.26 [0.95, 1.05]
LSAS.SR_14a 1 -0.40 [0.95, 1.05]
LSAS.SR_18b 1.035 -0.72 [0.95, 1.05]
LSAS.SR_19a 1.02 0.35 [0.95, 1.05]
LSAS.SR_22a 0.958 0.43 [0.95, 1.05]
LSAS.SR_24a 0.954 0.80 [0.95, 1.05]
Note:
MSQ values based on conditional estimation (n = 1612 complete cases).
Code
# Getting error for estimating the simfit for LSAS. 
# Getting same error for week 2 and week 1 
#df_week02 <- df %>% filter(Time=='WEEK02') %>% select(!Time) 
simfit1 <- RIgetfit(df_ls, iterations = 300, cpu = n_cores)  # 

RIitemfit(df_ls, simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 1.036 [0.919, 1.074] 1.042 [0.912, 1.091] no misfit no misfit -0.05
LSAS.SR_5b 1.011 [0.933, 1.075] 1.014 [0.929, 1.081] no misfit no misfit -0.12
LSAS.SR_8a 1.031 [0.935, 1.084] 1.055 [0.925, 1.111] no misfit no misfit -0.03
LSAS.SR_10a 0.966 [0.923, 1.081] 0.966 [0.911, 1.098] no misfit no misfit -0.26
LSAS.SR_14a 1 [0.917, 1.082] 0.996 [0.908, 1.096] no misfit no misfit -0.40
LSAS.SR_18b 1.035 [0.927, 1.087] 1.047 [0.898, 1.111] no misfit no misfit -0.72
LSAS.SR_19a 1.02 [0.934, 1.062] 1.015 [0.933, 1.068] no misfit no misfit 0.35
LSAS.SR_22a 0.958 [0.94, 1.062] 0.939 [0.936, 1.067] no misfit no misfit 0.43
LSAS.SR_24a 0.954 [0.944, 1.078] 0.916 [0.938, 1.092] no misfit 0.022 0.80
Note:
MSQ values based on conditional calculations (n = 1612 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RIgetfitPlot(simfit1, df_ls)

Code
#skipped right now 
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 1:4, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[1:4])

### also suggested:
# library(RASCHplot) # install first with `devtools::install_github("ERRTG/RASCHplot")`
# CICCplot(PCM(df),
#          which.item = c(1:4),
#          lower.groups = c(0,7,14,21,28,35),
#          grid.items = TRUE)
Code
#ICCplot(as.data.frame(df_pre), 
#        itemnumber = 5:7, 
#        method = "cut", 
#        itemdescrip = itemlabels$itemnr[5:7])

This is severely limited due to the large number of items

Code
Item Observed value Model expected value Absolute difference Adjusted p-value (BH) Statistical significance level Location Relative location
LSAS.SR_2b 0.47 0.49 0.02 0.673 -0.05 -0.14
LSAS.SR_5b 0.50 0.49 0.01 0.986 -0.12 -0.21
LSAS.SR_8a 0.49 0.49 0.00 0.810 -0.03 -0.11
LSAS.SR_10a 0.53 0.50 0.03 0.487 -0.26 -0.34
LSAS.SR_14a 0.49 0.49 0.00 0.894 -0.40 -0.49
LSAS.SR_18b 0.47 0.50 0.03 0.626 -0.72 -0.80
LSAS.SR_19a 0.48 0.50 0.02 0.713 0.35 0.26
LSAS.SR_22a 0.53 0.50 0.03 0.487 0.43 0.34
LSAS.SR_24a 0.54 0.50 0.04 0.224 0.80 0.71
Code
RIbootRestscore(df_ls,cpu=n_cores,iterations = 500,samplesize=800) # samplesize=600
Item Item-restscore result % of iterations Conditional MSQ infit Relative average item location
LSAS.SR_10a no misfit 96.4 0.97 -0.34
LSAS.SR_14a no misfit 100.0 1.00 -0.49
LSAS.SR_18b no misfit 99.2 1.04 -0.80
LSAS.SR_19a no misfit 99.6 1.02 0.26
LSAS.SR_22a no misfit 96.0 0.96 0.34
LSAS.SR_24a no misfit 89.8 0.95 0.71
LSAS.SR_24a overfit 10.2 0.95 0.71
LSAS.SR_2b no misfit 99.2 1.04 -0.14
LSAS.SR_5b no misfit 99.4 1.01 -0.21
LSAS.SR_8a no misfit 99.8 1.03 -0.11
Note:
Results based on 500 bootstrap iterations with a sample size of 800. Conditional mean-square infit based on complete responders only, n = 1612.
Code
RIpcmPCA(df_ls)
PCA of Rasch model residuals
Eigenvalues Proportion of variance
1.63 17.7%
1.37 15.6%
1.14 13.1%
1.13 12.6%
1.01 11.7%
Code
source('mod_easyRasch_func.R') # Reloading function req. 
simcor1 <- RIgetResidCor(df_ls, iterations = 500, cpu = n_cores) # 500
RIresidcorr(df_ls, cutoff = simcor1$p99)
LSAS.SR_2b LSAS.SR_5b LSAS.SR_8a LSAS.SR_10a LSAS.SR_14a LSAS.SR_18b LSAS.SR_19a LSAS.SR_22a LSAS.SR_24a
LSAS.SR_2b
LSAS.SR_5b 0.02
LSAS.SR_8a -0.13 -0.08
LSAS.SR_10a -0.22 -0.11 -0.14
LSAS.SR_14a 0.08 -0.16 0.02 -0.23
LSAS.SR_18b -0.06 -0.02 -0.18 -0.08 -0.17
LSAS.SR_19a -0.08 -0.09 -0.13 -0.11 -0.06 -0.11
LSAS.SR_22a -0.21 -0.21 -0.09 -0.01 -0.13 -0.17 -0.14
LSAS.SR_24a -0.22 -0.18 -0.15 0.03 -0.16 -0.08 -0.17 0.1
Note:
Relative cut-off value is -0.018, which is 0.088 above the average correlation (-0.106).
Correlations above the cut-off are highlighted in red text.
Code
Item 1 Item 2 Partial gamma SE Lower CI Upper CI Adjusted p-value (BH)
LSAS.SR_24a LSAS.SR_22a 0.299 0.037 0.226 0.372 0.000
LSAS.SR_22a LSAS.SR_24a 0.298 0.037 0.225 0.371 0.000
LSAS.SR_14a LSAS.SR_2b 0.246 0.038 0.171 0.322 0.000
LSAS.SR_2b LSAS.SR_14a 0.234 0.038 0.158 0.309 0.000
LSAS.SR_24a LSAS.SR_10a 0.209 0.037 0.136 0.282 0.000
LSAS.SR_10a LSAS.SR_24a 0.203 0.038 0.129 0.277 0.000
LSAS.SR_14a LSAS.SR_8a 0.185 0.038 0.110 0.260 0.000
LSAS.SR_8a LSAS.SR_14a 0.176 0.038 0.101 0.251 0.000
LSAS.SR_10a LSAS.SR_22a 0.168 0.038 0.094 0.243 0.001
LSAS.SR_22a LSAS.SR_10a 0.168 0.038 0.094 0.242 0.001
LSAS.SR_5b LSAS.SR_2b 0.156 0.040 0.078 0.233 0.006
LSAS.SR_2b LSAS.SR_5b 0.142 0.039 0.065 0.219 0.021
Code
RIloadLoc(df_ls)

Code
mirt(df_ls, model=1, itemtype='Rasch', verbose = FALSE) %>% 
  plot(type="trace", as.table = TRUE, 
       theta_lim = c(-6,6))

Code
# for fewer items or a more magnified figure, use:
#RIitemCats(df)
Code
# increase fig-height above as needed, if you have many items
RItargeting(df_ls)

Code

Code
iarm::score_groups(as.data.frame(df_ls)) %>% 
  as.data.frame(nm = "score_group") %>% 
  dplyr::count(score_group)
  score_group   n
1           1 792
2           2 820
Code
dif_plots <- df_ls %>% 
  add_column(dif = iarm::score_groups(.)) %>% 
  split(.$dif) %>% # split the data using the DIF variable
  map(~ RItileplot(.x %>% dplyr::select(!dif)) + labs(title = .x$dif))
dif_plots[[1]] + dif_plots[[2]]

Code
clr_tests(df_ls, model = "PCM")

Conditional Likelihood Ratio Tests:
        clr  df pvalue sig
overall 36.7 26 0.08    .
Code 
Score group 1: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.1080   1.0807   1.1699    
LSAS.SR_5b   1.0762   1.0784  -0.0903    
LSAS.SR_8a   1.0801   1.0717   0.3244    
LSAS.SR_10a  1.1487   1.1656  -0.6097    
LSAS.SR_14a  1.2706   1.2759  -0.2064    
LSAS.SR_18b  1.4562   1.4402   0.5984    
LSAS.SR_19a  0.8310   0.8154   0.6216    
LSAS.SR_22a  0.7230   0.7296  -0.2632    
LSAS.SR_24a  0.4740   0.5102  -1.5858    

Score group 2: 
            mean obs mean exp std.res sig
LSAS.SR_2b   1.9080   1.9343  -1.0373    
LSAS.SR_5b   2.0086   2.0065   0.0804    
LSAS.SR_8a   2.0356   2.0437  -0.3197    
LSAS.SR_10a  2.2736   2.2572   0.6454    
LSAS.SR_14a  2.1902   2.1851   0.2061    
LSAS.SR_18b  2.3742   2.3896  -0.6511    
LSAS.SR_19a  1.8258   1.8408  -0.5566    
LSAS.SR_22a  1.8110   1.8047   0.2260    
LSAS.SR_24a  1.5730   1.5380   1.2059
Code
grouping_based_on_score = score_groups(as.data.frame(df_ls))
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = grouping_based_on_score) 
         Item                     Var gamma  se pvalue padj.BH sig lower upper
1  LSAS.SR_2b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
2  LSAS.SR_5b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
3  LSAS.SR_8a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
4 LSAS.SR_10a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
5 LSAS.SR_14a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
6 LSAS.SR_18b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
7 LSAS.SR_19a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
8 LSAS.SR_22a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
9 LSAS.SR_24a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
Code
dif.sex <- dif %>% filter(Time=='PRE') %>% select(sex) %>% as.vector(.)
dif.sex <- dif.sex[[1]] #female = 1, male = 2 
RIdifTable(df_ls, dif.sex)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.019 -0.147 -0.064 0.117 0.166
LSAS.SR_5b -0.108 -0.137 -0.123 0.021 0.029
LSAS.SR_8a -0.170 0.160 -0.005 0.234 0.330
LSAS.SR_10a -0.308 -0.188 -0.248 0.084 0.119
LSAS.SR_14a -0.458 -0.303 -0.380 0.110 0.155
LSAS.SR_18b -0.740 -0.694 -0.717 0.032 0.046
LSAS.SR_19a 0.457 0.192 0.324 0.187 0.265
LSAS.SR_22a 0.518 0.296 0.407 0.157 0.223
LSAS.SR_24a 0.789 0.821 0.805 0.022 0.032
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.sex) 
         Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1  LSAS.SR_2b dif.sex  0.0881 0.0469 0.0603  0.5424      -0.0038  0.1800
2  LSAS.SR_5b dif.sex -0.0169 0.0474 0.7215  1.0000      -0.1098  0.0760
3  LSAS.SR_8a dif.sex -0.2056 0.0447 0.0000  0.0000  *** -0.2932 -0.1180
4 LSAS.SR_10a dif.sex -0.0964 0.0456 0.0346  0.3116      -0.1859 -0.0070
5 LSAS.SR_14a dif.sex -0.1481 0.0461 0.0013  0.0118    * -0.2383 -0.0578
6 LSAS.SR_18b dif.sex -0.0299 0.0467 0.5220  1.0000      -0.1214  0.0616
7 LSAS.SR_19a dif.sex  0.1599 0.0446 0.0003  0.0030   **  0.0726  0.2473
8 LSAS.SR_22a dif.sex  0.2088 0.0443 0.0000  0.0000  ***  0.1219  0.2957
9 LSAS.SR_24a dif.sex  0.0630 0.0475 0.1842  1.0000      -0.0300  0.1561
Code
dif.age <- dif %>% filter(Time=='PRE') %>% select(age) %>% as.vector(.)
dif.age <- dif.age[[1]]
RIdifTable(df_ls, dif.age)

Item 3 4 5 Mean location StDev MaxDiff
LSAS.SR_2b -0.032 -0.032 -0.135 -0.067 0.059 0.103
LSAS.SR_5b 0.014 -0.126 -0.238 -0.117 0.127 0.253
LSAS.SR_8a 0.037 -0.005 -0.139 -0.036 0.092 0.176
LSAS.SR_10a -0.427 -0.292 -0.058 -0.259 0.187 0.369
LSAS.SR_14a -0.324 -0.293 -0.627 -0.415 0.184 0.334
LSAS.SR_18b -0.512 -0.791 -0.773 -0.692 0.156 0.279
LSAS.SR_19a 0.271 0.317 0.434 0.341 0.084 0.163
LSAS.SR_22a 0.284 0.411 0.674 0.456 0.199 0.390
LSAS.SR_24a 0.690 0.811 0.864 0.788 0.089 0.174
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.age) 
         Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1  LSAS.SR_2b dif.age  0.0285 0.0287 0.3196  1.0000      -0.0277  0.0847
2  LSAS.SR_5b dif.age  0.0615 0.0287 0.0322  0.2901       0.0052  0.1178
3  LSAS.SR_8a dif.age  0.0609 0.0274 0.0262  0.2358       0.0072  0.1145
4 LSAS.SR_10a dif.age -0.1267 0.0273 0.0000  0.0000  *** -0.1802 -0.0732
5 LSAS.SR_14a dif.age  0.0663 0.0277 0.0166  0.1496       0.0120  0.1205
6 LSAS.SR_18b dif.age  0.0104 0.0284 0.7156  1.0000      -0.0454  0.0661
7 LSAS.SR_19a dif.age -0.0281 0.0276 0.3095  1.0000      -0.0822  0.0260
8 LSAS.SR_22a dif.age -0.0378 0.0279 0.1756  1.0000      -0.0925  0.0169
9 LSAS.SR_24a dif.age -0.0290 0.0280 0.3003  1.0000      -0.0839  0.0259
Code
dif.edu <- dif %>% filter(Time=='PRE') %>% select(education) %>% as.vector(.)
dif.edu <- dif.edu[[1]]
RIdifTable(df_ls, dif.edu)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b -0.160 0.102 -0.029 0.185 0.261
LSAS.SR_5b -0.023 -0.246 -0.135 0.157 0.222
LSAS.SR_8a 0.004 -0.082 -0.039 0.061 0.086
LSAS.SR_10a -0.263 -0.235 -0.249 0.020 0.028
LSAS.SR_14a -0.424 -0.373 -0.398 0.036 0.051
LSAS.SR_18b -0.610 -0.856 -0.733 0.174 0.246
LSAS.SR_19a 0.290 0.413 0.351 0.087 0.123
LSAS.SR_22a 0.401 0.473 0.437 0.051 0.072
LSAS.SR_24a 0.786 0.804 0.795 0.013 0.018
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.edu) 
         Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1  LSAS.SR_2b dif.edu -0.1477 0.0419 0.0004  0.0038   ** -0.2298 -0.0656
2  LSAS.SR_5b dif.edu  0.1633 0.0426 0.0001  0.0011   **  0.0799  0.2468
3  LSAS.SR_8a dif.edu  0.0795 0.0417 0.0568  0.5109      -0.0023  0.1613
4 LSAS.SR_10a dif.edu -0.0250 0.0421 0.5529  1.0000      -0.1076  0.0576
5 LSAS.SR_14a dif.edu -0.0785 0.0420 0.0617  0.5557      -0.1608  0.0039
6 LSAS.SR_18b dif.edu  0.1645 0.0411 0.0001  0.0006  ***  0.0838  0.2451
7 LSAS.SR_19a dif.edu -0.0644 0.0415 0.1206  1.0000      -0.1458  0.0169
8 LSAS.SR_22a dif.edu -0.0532 0.0419 0.2038  1.0000      -0.1353  0.0289
9 LSAS.SR_24a dif.edu -0.0067 0.0438 0.8784  1.0000      -0.0925  0.0791
Code
dif.yr <- dif %>% filter(Time=='PRE') %>% select(TreatmentAccessStart) %>% as.vector(.)
dif.yr <- dif.yr[[1]]
RIdifTable(df_ls, dif.yr)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b -0.145 0.129 -0.008 0.193 0.273
LSAS.SR_5b -0.132 -0.098 -0.115 0.024 0.034
LSAS.SR_8a -0.031 -0.023 -0.027 0.005 0.008
LSAS.SR_10a -0.206 -0.357 -0.281 0.106 0.150
LSAS.SR_14a -0.482 -0.252 -0.367 0.163 0.230
LSAS.SR_18b -0.648 -0.876 -0.762 0.161 0.228
LSAS.SR_19a 0.336 0.372 0.354 0.025 0.036
LSAS.SR_22a 0.406 0.472 0.439 0.047 0.066
LSAS.SR_24a 0.901 0.633 0.767 0.190 0.268
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.yr) 
         Item    Var   gamma     se pvalue padj.BH sig   lower   upper
1  LSAS.SR_2b dif.yr -0.1003 0.0301 0.0009  0.0079  ** -0.1594 -0.0412
2  LSAS.SR_5b dif.yr -0.0290 0.0299 0.3331  1.0000     -0.0876  0.0297
3  LSAS.SR_8a dif.yr  0.0150 0.0296 0.6129  1.0000     -0.0431  0.0731
4 LSAS.SR_10a dif.yr  0.0818 0.0299 0.0061  0.0553   .  0.0233  0.1403
5 LSAS.SR_14a dif.yr -0.0813 0.0308 0.0084  0.0756   . -0.1417 -0.0208
6 LSAS.SR_18b dif.yr  0.0938 0.0296 0.0015  0.0139   *  0.0357  0.1518
7 LSAS.SR_19a dif.yr -0.0010 0.0290 0.9721  1.0000     -0.0578  0.0558
8 LSAS.SR_22a dif.yr -0.0621 0.0302 0.0396  0.3568     -0.1212 -0.0029
9 LSAS.SR_24a dif.yr  0.0711 0.0304 0.0195  0.1752      0.0115  0.1308

14.1 Analysis part 5 decision

24a “Resiting sales” do show some misfit, residual correlations and overfitting in the boostrap. Its not much, however the item does have better targetting than 22a. Removing 22a.

15 Rasch analysis 6

Removing 22a

Code
df_ls <- df_ls %>% select(!c(LSAS.SR_22a))
RIlistItemsMargin(df_ls, fontsize = 12)
itemnr item
LSAS.SR_2b small group avoid
LSAS.SR_5b talking authority avoid
LSAS.SR_8a work obs anxiety
LSAS.SR_10a call new anxiety
LSAS.SR_14a enter room anxiety
LSAS.SR_18b disagreement avoid
LSAS.SR_19a eye contact anxiety
LSAS.SR_24a resisting sales anxiety
Code
RIitemfit(df_ls, cutoff = "Smith98")
Item InfitMSQ Location 1 ± 2 / √n
LSAS.SR_2b 1.003 0.00 [0.95, 1.05]
LSAS.SR_5b 0.976 -0.07 [0.95, 1.05]
LSAS.SR_8a 1.031 0.03 [0.95, 1.05]
LSAS.SR_10a 0.988 -0.20 [0.95, 1.05]
LSAS.SR_14a 0.988 -0.34 [0.95, 1.05]
LSAS.SR_18b 1.012 -0.66 [0.95, 1.05]
LSAS.SR_19a 1.008 0.40 [0.95, 1.05]
LSAS.SR_24a 1.011 0.85 [0.95, 1.05]
Note:
MSQ values based on conditional estimation (n = 1612 complete cases).
Code
# Getting error for estimating the simfit for LSAS. 
# Getting same error for week 2 and week 1 
#df_week02 <- df %>% filter(Time=='WEEK02') %>% select(!Time) 
simfit1 <- RIgetfit(df_ls, iterations = 300, cpu = n_cores)  # 

RIitemfit(df_ls, simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 1.003 [0.929, 1.072] 1.008 [0.916, 1.098] no misfit no misfit 0.00
LSAS.SR_5b 0.976 [0.917, 1.09] 0.973 [0.912, 1.091] no misfit no misfit -0.07
LSAS.SR_8a 1.031 [0.941, 1.089] 1.061 [0.933, 1.105] no misfit no misfit 0.03
LSAS.SR_10a 0.988 [0.922, 1.089] 0.984 [0.919, 1.1] no misfit no misfit -0.20
LSAS.SR_14a 0.988 [0.91, 1.091] 0.984 [0.903, 1.111] no misfit no misfit -0.34
LSAS.SR_18b 1.012 [0.932, 1.105] 1.014 [0.927, 1.096] no misfit no misfit -0.66
LSAS.SR_19a 1.008 [0.918, 1.045] 1.005 [0.91, 1.05] no misfit no misfit 0.40
LSAS.SR_24a 1.011 [0.938, 1.081] 0.976 [0.933, 1.088] no misfit no misfit 0.85
Note:
MSQ values based on conditional calculations (n = 1612 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RIgetfitPlot(simfit1, df_ls)

Code
#skipped right now 
ICCplot(as.data.frame(df_pre), 
        itemnumber = 1:4, 
        method = "cut", 
        itemdescrip = itemlabels$itemnr[c(4,10,15,19)])

[1] "Please press Zoom on the Plots window to see the plot"
Code
### also suggested:
# library(RASCHplot) # install first with `devtools::install_github("ERRTG/RASCHplot")`
# CICCplot(PCM(df),
#          which.item = c(1:4),
#          lower.groups = c(0,7,14,21,28,35),
#          grid.items = TRUE)
Code
ICCplot(as.data.frame(df_pre), 
        itemnumber = 5:8, 
        method = "cut", 
        itemdescrip = itemlabels$itemnr[c(27,36,37,43)])

[1] "Please press Zoom on the Plots window to see the plot"
Code
Item Observed value Model expected value Absolute difference Adjusted p-value (BH) Statistical significance level Location Relative location
LSAS.SR_2b 0.48 0.48 0.00 0.853 0.00 -0.14
LSAS.SR_5b 0.51 0.49 0.02 0.853 -0.07 -0.21
LSAS.SR_8a 0.48 0.49 0.01 0.853 0.03 -0.11
LSAS.SR_10a 0.51 0.50 0.01 0.853 -0.20 -0.34
LSAS.SR_14a 0.49 0.48 0.01 0.853 -0.34 -0.48
LSAS.SR_18b 0.48 0.49 0.01 0.853 -0.66 -0.80
LSAS.SR_19a 0.48 0.49 0.01 0.853 0.40 0.26
LSAS.SR_24a 0.50 0.49 0.01 0.853 0.85 0.71
Code
RIbootRestscore(df_ls,cpu=n_cores,iterations = 500,samplesize=800) # samplesize=600
Item Item-restscore result % of iterations Conditional MSQ infit Relative average item location
LSAS.SR_10a no misfit 99.6 0.99 -0.34
LSAS.SR_14a no misfit 98.8 0.99 -0.48
LSAS.SR_18b no misfit 99.8 1.01 -0.80
LSAS.SR_19a no misfit 99.8 1.01 0.26
LSAS.SR_24a no misfit 99.8 1.01 0.71
LSAS.SR_2b no misfit 99.6 1.00 -0.14
LSAS.SR_5b no misfit 97.0 0.98 -0.21
LSAS.SR_8a no misfit 100.0 1.03 -0.11
Note:
Results based on 500 bootstrap iterations with a sample size of 800. Conditional mean-square infit based on complete responders only, n = 1612.
Code
RIpcmPCA(df_ls)
PCA of Rasch model residuals
Eigenvalues Proportion of variance
1.53 19%
1.32 16.7%
1.17 14.8%
1.14 14.2%
1.03 13%
Code
source('mod_easyRasch_func.R') # Reloading function req. 
simcor1 <- RIgetResidCor(df_ls, iterations = 500, cpu = n_cores) # 500
RIresidcorr(df_ls, cutoff = simcor1$p99)
LSAS.SR_2b LSAS.SR_5b LSAS.SR_8a LSAS.SR_10a LSAS.SR_14a LSAS.SR_18b LSAS.SR_19a LSAS.SR_24a
LSAS.SR_2b
LSAS.SR_5b -0.02
LSAS.SR_8a -0.15 -0.1
LSAS.SR_10a -0.23 -0.12 -0.13
LSAS.SR_14a 0.05 -0.19 0.01 -0.23
LSAS.SR_18b -0.09 -0.04 -0.2 -0.08 -0.19
LSAS.SR_19a -0.11 -0.12 -0.14 -0.12 -0.07 -0.14
LSAS.SR_24a -0.22 -0.18 -0.14 0.05 -0.15 -0.07 -0.15
Note:
Relative cut-off value is -0.026, which is 0.092 above the average correlation (-0.118).
Correlations above the cut-off are highlighted in red text.
Code
Item 1 Item 2 Partial gamma SE Lower CI Upper CI Adjusted p-value (BH)
LSAS.SR_24a LSAS.SR_10a 0.249 0.036 0.179 0.320 0.000
LSAS.SR_10a LSAS.SR_24a 0.248 0.037 0.176 0.321 0.000
LSAS.SR_14a LSAS.SR_2b 0.227 0.039 0.151 0.304 0.000
LSAS.SR_2b LSAS.SR_14a 0.217 0.039 0.141 0.294 0.000
LSAS.SR_14a LSAS.SR_8a 0.184 0.038 0.109 0.259 0.000
LSAS.SR_8a LSAS.SR_14a 0.176 0.038 0.101 0.251 0.000
LSAS.SR_5b LSAS.SR_2b 0.133 0.040 0.055 0.211 0.048
Code
RIloadLoc(df_ls)

Code
mirt(df_ls, model=1, itemtype='Rasch', verbose = FALSE) %>% 
  plot(type="trace", as.table = TRUE, 
       theta_lim = c(-6,6))

Code
# for fewer items or a more magnified figure, use:
#RIitemCats(df)
Code
# increase fig-height above as needed, if you have many items
RItargeting(df_ls)

Code

Code
iarm::score_groups(as.data.frame(df_ls)) %>% 
  as.data.frame(nm = "score_group") %>% 
  dplyr::count(score_group)
  score_group   n
1           1 811
2           2 801
Code
dif_plots <- df_ls %>% 
  add_column(dif = iarm::score_groups(.)) %>% 
  split(.$dif) %>% # split the data using the DIF variable
  map(~ RItileplot(.x %>% dplyr::select(!dif)) + labs(title = .x$dif))
dif_plots[[1]] + dif_plots[[2]]

Code
clr_tests(df_ls, model = "PCM")

Conditional Likelihood Ratio Tests:
        clr  df pvalue sig
overall 32.3 23 0.094   .
Code 
Score group 1: 
            mean obs  mean exp  std.res   sig
LSAS.SR_2b   1.094293  1.086557  0.336364    
LSAS.SR_5b   1.084367  1.084378 -0.000464    
LSAS.SR_8a   1.080645  1.079116  0.060022    
LSAS.SR_10a  1.177419  1.174369  0.111251    
LSAS.SR_14a  1.271712  1.282974 -0.451571    
LSAS.SR_18b  1.459057  1.448267  0.411510    
LSAS.SR_19a  0.823821  0.821984  0.074034    
LSAS.SR_24a  0.501241  0.514910 -0.605266    

Score group 2: 
            mean obs mean exp std.res  sig
LSAS.SR_2b   1.93962  1.94746 -0.30654    
LSAS.SR_5b   2.02138  2.02135  0.00109    
LSAS.SR_8a   2.05660  2.05816 -0.06114    
LSAS.SR_10a  2.27044  2.27356 -0.12256    
LSAS.SR_14a  2.21006  2.19864  0.46454    
LSAS.SR_18b  2.39245  2.40338 -0.46165    
LSAS.SR_19a  1.85535  1.85721 -0.06849    
LSAS.SR_24a  1.56981  1.55595  0.47519
Code
grouping_based_on_score = score_groups(as.data.frame(df_ls))
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = grouping_based_on_score) 
         Item                     Var gamma  se pvalue padj.BH sig lower upper
1  LSAS.SR_2b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
2  LSAS.SR_5b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
3  LSAS.SR_8a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
4 LSAS.SR_10a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
5 LSAS.SR_14a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
6 LSAS.SR_18b grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
7 LSAS.SR_19a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
8 LSAS.SR_24a grouping_based_on_score   NaN NaN     NA      NA   ?    NA    NA
Code
dif.sex <- dif %>% filter(Time=='PRE') %>% select(sex) %>% as.vector(.)
dif.sex <- dif.sex[[1]] #female = 1, male = 2 
RIdifTable(df_ls, dif.sex)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.083 -0.109 -0.013 0.136 0.192
LSAS.SR_5b -0.043 -0.100 -0.072 0.040 0.056
LSAS.SR_8a -0.104 0.196 0.046 0.212 0.300
LSAS.SR_10a -0.241 -0.150 -0.196 0.064 0.091
LSAS.SR_14a -0.390 -0.263 -0.326 0.090 0.127
LSAS.SR_18b -0.669 -0.651 -0.660 0.013 0.018
LSAS.SR_19a 0.517 0.227 0.372 0.206 0.291
LSAS.SR_24a 0.847 0.850 0.848 0.002 0.003
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.sex) 
         Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1  LSAS.SR_2b dif.sex  0.1380 0.0469 0.0033  0.0261    *  0.0461  0.2300
2  LSAS.SR_5b dif.sex  0.0280 0.0478 0.5577  1.0000      -0.0657  0.1217
3  LSAS.SR_8a dif.sex -0.1987 0.0452 0.0000  0.0001  *** -0.2872 -0.1102
4 LSAS.SR_10a dif.sex -0.0725 0.0457 0.1127  0.9016      -0.1620  0.0171
5 LSAS.SR_14a dif.sex -0.1252 0.0463 0.0068  0.0544    . -0.2159 -0.0346
6 LSAS.SR_18b dif.sex -0.0027 0.0471 0.9537  1.0000      -0.0951  0.0896
7 LSAS.SR_19a dif.sex  0.1898 0.0444 0.0000  0.0002  ***  0.1028  0.2767
8 LSAS.SR_24a dif.sex  0.0840 0.0471 0.0743  0.5940      -0.0082  0.1763
Code
dif.age <- dif %>% filter(Time=='PRE') %>% select(age) %>% as.vector(.)
dif.age <- dif.age[[1]]
RIdifTable(df_ls, dif.age)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b 0.016 -0.045 -0.014 0.043 0.061
LSAS.SR_5b -0.024 -0.177 -0.101 0.109 0.154
LSAS.SR_8a 0.053 -0.055 -0.001 0.076 0.108
LSAS.SR_10a -0.302 0.053 -0.124 0.251 0.355
LSAS.SR_14a -0.260 -0.557 -0.409 0.210 0.296
LSAS.SR_18b -0.643 -0.677 -0.660 0.024 0.034
LSAS.SR_19a 0.339 0.537 0.438 0.140 0.198
LSAS.SR_24a 0.821 0.920 0.871 0.070 0.099
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.age) 
         Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1  LSAS.SR_2b dif.age  0.0220 0.0291 0.4501  1.0000      -0.0351  0.0790
2  LSAS.SR_5b dif.age  0.0608 0.0289 0.0354  0.2832       0.0042  0.1174
3  LSAS.SR_8a dif.age  0.0592 0.0276 0.0319  0.2554       0.0051  0.1133
4 LSAS.SR_10a dif.age -0.1379 0.0270 0.0000  0.0000  *** -0.1909 -0.0849
5 LSAS.SR_14a dif.age  0.0572 0.0281 0.0420  0.3358       0.0021  0.1124
6 LSAS.SR_18b dif.age  0.0201 0.0285 0.4807  1.0000      -0.0357  0.0759
7 LSAS.SR_19a dif.age -0.0317 0.0276 0.2514  1.0000      -0.0859  0.0225
8 LSAS.SR_24a dif.age -0.0340 0.0279 0.2226  1.0000      -0.0887  0.0207
Code
dif.edu <- dif %>% filter(Time=='PRE') %>% select(education) %>% as.vector(.)
dif.edu <- dif.edu[[1]]
RIdifTable(df_ls, dif.edu)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b -0.109 0.160 0.026 0.190 0.269
LSAS.SR_5b 0.025 -0.186 -0.080 0.149 0.211
LSAS.SR_8a 0.054 -0.024 0.015 0.055 0.077
LSAS.SR_10a -0.211 -0.176 -0.194 0.025 0.035
LSAS.SR_14a -0.369 -0.312 -0.341 0.040 0.057
LSAS.SR_18b -0.554 -0.794 -0.674 0.170 0.240
LSAS.SR_19a 0.336 0.471 0.403 0.095 0.135
LSAS.SR_24a 0.828 0.861 0.845 0.023 0.033
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.edu) 
         Item     Var   gamma     se pvalue padj.BH  sig   lower   upper
1  LSAS.SR_2b dif.edu -0.1537 0.0421 0.0003  0.0021   ** -0.2362 -0.0712
2  LSAS.SR_5b dif.edu  0.1545 0.0433 0.0004  0.0029   **  0.0696  0.2393
3  LSAS.SR_8a dif.edu  0.0743 0.0418 0.0754  0.6035      -0.0076  0.1562
4 LSAS.SR_10a dif.edu -0.0394 0.0415 0.3420  1.0000      -0.1208  0.0419
5 LSAS.SR_14a dif.edu -0.0975 0.0422 0.0208  0.1668      -0.1802 -0.0148
6 LSAS.SR_18b dif.edu  0.1878 0.0414 0.0000  0.0000  ***  0.1067  0.2688
7 LSAS.SR_19a dif.edu -0.0800 0.0409 0.0503  0.4021      -0.1600  0.0001
8 LSAS.SR_24a dif.edu -0.0304 0.0432 0.4814  1.0000      -0.1150  0.0542
Code
dif.yr <- dif %>% filter(Time=='PRE') %>% select(TreatmentAccessStart) %>% as.vector(.)
dif.yr <- dif.yr[[1]]
RIdifTable(df_ls, dif.yr)

Item 2 3 Mean location StDev MaxDiff
LSAS.SR_2b -0.093 0.188 0.048 0.199 0.281
LSAS.SR_5b -0.081 -0.038 -0.060 0.030 0.043
LSAS.SR_8a 0.020 0.036 0.028 0.011 0.016
LSAS.SR_10a -0.154 -0.299 -0.226 0.103 0.145
LSAS.SR_14a -0.426 -0.193 -0.310 0.164 0.232
LSAS.SR_18b -0.590 -0.816 -0.703 0.160 0.226
LSAS.SR_19a 0.382 0.431 0.407 0.034 0.048
LSAS.SR_24a 0.941 0.692 0.817 0.176 0.249
Code
partgam_DIF(dat.items = as.data.frame(df_ls),
            dat.exo = dif.yr) 
         Item    Var   gamma     se pvalue padj.BH  sig   lower   upper
1  LSAS.SR_2b dif.yr -0.1222 0.0297 0.0000  0.0003  *** -0.1804 -0.0639
2  LSAS.SR_5b dif.yr -0.0347 0.0303 0.2520  1.0000      -0.0940  0.0247
3  LSAS.SR_8a dif.yr  0.0004 0.0293 0.9899  1.0000      -0.0571  0.0578
4 LSAS.SR_10a dif.yr  0.0744 0.0297 0.0122  0.0973    .  0.0162  0.1325
5 LSAS.SR_14a dif.yr -0.0848 0.0307 0.0058  0.0465    * -0.1450 -0.0245
6 LSAS.SR_18b dif.yr  0.0856 0.0297 0.0039  0.0316    *  0.0274  0.1437
7 LSAS.SR_19a dif.yr -0.0084 0.0289 0.7713  1.0000      -0.0650  0.0482
8 LSAS.SR_24a dif.yr  0.0658 0.0300 0.0284  0.2272       0.0070  0.1247

15.1 Analysis part 6 decision

Testing to move on with this scale.

16 Analysis conclusion

Resulting LSAS-SR reworked scale thus has item as seen in margin below

16.1 Resulting items

Code
what_scale <- gsub('\\.','',items_to_use)
Code
RIlistItemsMargin(df_ls, fontsize = 12)
itemnr item
LSAS.SR_2b small group avoid
LSAS.SR_5b talking authority avoid
LSAS.SR_8a work obs anxiety
LSAS.SR_10a call new anxiety
LSAS.SR_14a enter room anxiety
LSAS.SR_18b disagreement avoid
LSAS.SR_19a eye contact anxiety
LSAS.SR_24a resisting sales anxiety

16.2 Reliability

Code
RItif(df_ls)

Code
RItif(df_ls,samplePSI=TRUE)

16.3 Person parameter

Code
RIpfit(df_ls)

16.4 Misfit check

Code
pfit_u3poly <- PerFit::U3poly(matrix = df_ls, 
                      Ncat = 4, # make sure to input number of response categories, not thresholds
                      IRT.PModel = "PCM")
misfits <- PerFit::flagged.resp(pfit_u3poly) %>% 
  pluck("Scores") %>% 
  as.data.frame() %>% 
  pull(FlaggedID)

misfits2 <- RIpfit(df_ls, output = "rowid")
Code
RIitemfit(df_ls, simcut = simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 1.003 [0.929, 1.072] 1.008 [0.916, 1.098] no misfit no misfit 0.00
LSAS.SR_5b 0.976 [0.917, 1.09] 0.973 [0.912, 1.091] no misfit no misfit -0.07
LSAS.SR_8a 1.031 [0.941, 1.089] 1.061 [0.933, 1.105] no misfit no misfit 0.03
LSAS.SR_10a 0.988 [0.922, 1.089] 0.984 [0.919, 1.1] no misfit no misfit -0.20
LSAS.SR_14a 0.988 [0.91, 1.091] 0.984 [0.903, 1.111] no misfit no misfit -0.34
LSAS.SR_18b 1.012 [0.932, 1.105] 1.014 [0.927, 1.096] no misfit no misfit -0.66
LSAS.SR_19a 1.008 [0.918, 1.045] 1.005 [0.91, 1.05] no misfit no misfit 0.40
LSAS.SR_24a 1.011 [0.938, 1.081] 0.976 [0.933, 1.088] no misfit no misfit 0.85
Note:
MSQ values based on conditional calculations (n = 1612 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RIitemfit(df_ls[-misfits,], simcut = simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 1.002 [0.929, 1.072] 1.007 [0.916, 1.098] no misfit no misfit 0.00
LSAS.SR_5b 0.964 [0.917, 1.09] 0.965 [0.912, 1.091] no misfit no misfit -0.10
LSAS.SR_8a 1.003 [0.941, 1.089] 1.008 [0.933, 1.105] no misfit no misfit 0.04
LSAS.SR_10a 0.99 [0.922, 1.089] 0.984 [0.919, 1.1] no misfit no misfit -0.25
LSAS.SR_14a 0.99 [0.91, 1.091] 0.982 [0.903, 1.111] no misfit no misfit -0.41
LSAS.SR_18b 1.002 [0.932, 1.105] 1.002 [0.927, 1.096] no misfit no misfit -0.83
LSAS.SR_19a 1.031 [0.918, 1.045] 1.033 [0.91, 1.05] no misfit no misfit 0.50
LSAS.SR_24a 1.03 [0.938, 1.081] 0.993 [0.933, 1.088] no misfit no misfit 1.06
Note:
MSQ values based on conditional calculations (n = 1431 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RItif(df_ls[-misfits,])

Code
RIitemfit(df_ls[-misfits2,], simcut = simfit1)
Item InfitMSQ Infit thresholds OutfitMSQ Outfit thresholds Infit diff Outfit diff Location
LSAS.SR_2b 1.006 [0.929, 1.072] 1.011 [0.916, 1.098] no misfit no misfit 0.00
LSAS.SR_5b 0.981 [0.917, 1.09] 0.976 [0.912, 1.091] no misfit no misfit -0.05
LSAS.SR_8a 1.026 [0.941, 1.089] 1.054 [0.933, 1.105] no misfit no misfit 0.02
LSAS.SR_10a 0.968 [0.922, 1.089] 0.962 [0.919, 1.1] no misfit no misfit -0.21
LSAS.SR_14a 1.002 [0.91, 1.091] 0.999 [0.903, 1.111] no misfit no misfit -0.35
LSAS.SR_18b 1.008 [0.932, 1.105] 1.009 [0.927, 1.096] no misfit no misfit -0.70
LSAS.SR_19a 1.014 [0.918, 1.045] 1.008 [0.91, 1.05] no misfit no misfit 0.41
LSAS.SR_24a 1.003 [0.938, 1.081] 0.96 [0.933, 1.088] no misfit no misfit 0.88
Note:
MSQ values based on conditional calculations (n = 1417 complete cases).
Simulation based thresholds from 300 simulated datasets.
Code
RItif(df_ls[-misfits2,])

16.5 Item parameters

Code
Threshold 1 Threshold 2 Threshold 3 Item location
LSAS.SR_2b -1.87 0.46 1.42 0
LSAS.SR_5b -1.80 0.51 1.10 -0.07
LSAS.SR_8a -1.32 0.07 1.32 0.03
LSAS.SR_10a -1.25 -0.09 0.73 -0.2
LSAS.SR_14a -1.99 -0.07 1.03 -0.34
LSAS.SR_18b -2.22 -0.23 0.48 -0.66
LSAS.SR_19a -0.77 0.45 1.51 0.4
LSAS.SR_24a 0.00 0.82 1.72 0.85
Note:
Item location is the average of the thresholds for each item.
Code
item_param_matrix <- RIitemparams(df_ls,output='dataframe') %>% as.matrix(.)
write.csv(item_param_matrix,file=paste0("./results/item_params_",what_scale,'.csv'),row.names=TRUE)

16.6 Ordinal sum to interval score

Code
RIscoreSE(df_ls)
Ordinal sum score Logit score Logit std.error
0 -4.420 0.674
1 -3.203 0.809
2 -2.571 0.749
3 -2.113 0.669
4 -1.743 0.604
5 -1.427 0.557
6 -1.149 0.522
7 -0.900 0.495
8 -0.674 0.475
9 -0.464 0.459
10 -0.267 0.446
11 -0.079 0.437
12 0.102 0.432
13 0.279 0.429
14 0.455 0.430
15 0.633 0.435
16 0.815 0.443
17 1.004 0.457
18 1.206 0.478
19 1.426 0.509
20 1.676 0.553
21 1.971 0.613
22 2.347 0.687
23 2.893 0.745
24 4.022 0.635
Code
RIscoreSE(df_ls,output='figure')

Code
sum_to_latent <- RIscoreSE(df_ls,output = 'dataframe')
write.csv(sum_to_latent,file=paste0('./results/ordinal_sum_to_latent_',what_scale,'.csv'),row.names=FALSE)

16.7 Thetas

The ordinal sum to interval score contains the information to transform into the below thetas, but we plot them here for convinience

Code
est_thetas2 <- RIestThetas(df_ls, method = "WLE")
hist(est_thetas2$WLE, 
     col = "#009ca6", 
     main = "Histogram of person locations (thetas)", 
     breaks = 25)

17 Software used

Code
pkgs <- grateful::cite_packages(cite.tidyverse = TRUE, 
                      output = "table",
                      bib.file = "grateful-refs.bib",
                      include.RStudio = FALSE,
                      out.dir = getwd())
formattable(pkgs, table.attr = 'class=\"table table-striped\" style="font-size: 15px; font-family: Lato; width: 80%"')
Package Version Citation
base 4.4.1 @base
car 3.1.3 @car
doParallel 1.0.17 @doParallel
easyRasch 0.3.3 @easyRasch
eRm 1.0.6 @eRm2007a; @eRm2007b; @eRm2009c; @eRm2013d; @eRm2015e; @eRm2019f
formattable 0.2.1 @formattable
furrr 0.3.1 @furrr
ggrepel 0.9.6 @ggrepel
glue 1.8.0 @glue
gridExtra 2.3 @gridExtra
iarm 0.4.3 @iarm
janitor 2.2.0 @janitor
kableExtra 1.4.0 @kableExtra
knitr 1.49 @knitr2014; @knitr2015; @knitr2024
lavaan 0.6.19 @lavaan
matrixStats 1.4.1 @matrixStats
mirt 1.43 @mirt
mokken 3.1.2 @mokken2007; @mokken2012
patchwork 1.3.0 @patchwork
PerFit 1.4.6 @PerFit
psych 2.4.6.26 @psych
psychotools 0.7.4 @psychotools2021; @psychotools2022; @psychotools2024
psychotree 0.16.1 @psychotree2010e; @psychotree2011a; @psychotree2015b; @psychotree2018c; @psychotree2018d
reshape 0.8.9 @reshape
rmarkdown 2.29 @rmarkdown2018; @rmarkdown2020; @rmarkdown2024
tidyverse 2.0.0 @tidyverse

18 References